aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lisp/gnus/gnus-ems.el266
-rw-r--r--lisp/gnus/gnus-sync.el917
-rw-r--r--lisp/gnus/messcompat.el91
-rw-r--r--lisp/nxml/nxml-glyph.el423
-rw-r--r--lisp/nxml/nxml-uchnm.el251
-rw-r--r--lisp/obsolete/awk-mode.el124
-rw-r--r--lisp/obsolete/iso-acc.el489
-rw-r--r--lisp/obsolete/iso-insert.el630
-rw-r--r--lisp/obsolete/iso-swed.el150
-rw-r--r--lisp/obsolete/resume.el125
-rw-r--r--lisp/obsolete/scribe.el329
-rw-r--r--lisp/obsolete/spell.el171
-rw-r--r--lisp/obsolete/swedish.el160
-rw-r--r--lisp/obsolete/sym-comp.el237
14 files changed, 0 insertions, 4363 deletions
diff --git a/lisp/gnus/gnus-ems.el b/lisp/gnus/gnus-ems.el
deleted file mode 100644
index 5067fa43cd3..00000000000
--- a/lisp/gnus/gnus-ems.el
+++ /dev/null
@@ -1,266 +0,0 @@
1;;; gnus-ems.el --- functions for making Gnus work under different Emacsen
2
3;; Copyright (C) 1995-2017 Free Software Foundation, Inc.
4
5;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
6;; Keywords: news
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software: you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22
23;;; Commentary:
24
25;;; Code:
26
27(eval-when-compile
28 (require 'cl)
29 (require 'ring))
30
31;;; Function aliases later to be redefined for XEmacs usage.
32
33(defvar gnus-mouse-2 [mouse-2])
34(defvar gnus-down-mouse-3 [down-mouse-3])
35(defvar gnus-down-mouse-2 [down-mouse-2])
36(defvar gnus-widget-button-keymap nil)
37(defvar gnus-mode-line-modified
38 (if (featurep 'xemacs)
39 '("--**-" . "-----")
40 '("**" "--")))
41
42(eval-and-compile
43 (autoload 'gnus-xmas-define "gnus-xmas")
44 (autoload 'gnus-xmas-redefine "gnus-xmas"))
45
46(autoload 'gnus-get-buffer-create "gnus")
47(autoload 'nnheader-find-etc-directory "nnheader")
48(autoload 'smiley-region "smiley")
49
50(defun gnus-kill-all-overlays ()
51 "Delete all overlays in the current buffer."
52 (let* ((overlayss (overlay-lists))
53 (buffer-read-only nil)
54 (overlays (delq nil (nconc (car overlayss) (cdr overlayss)))))
55 (while overlays
56 (delete-overlay (pop overlays)))))
57
58;;; Mule functions.
59
60(defun gnus-mule-max-width-function (el max-width)
61 `(let* ((val (eval (, el)))
62 (valstr (if (numberp val)
63 (int-to-string val) val)))
64 (if (> (length valstr) ,max-width)
65 (truncate-string-to-width valstr ,max-width)
66 valstr)))
67
68(eval-and-compile
69 (if (featurep 'xemacs)
70 (gnus-xmas-define)
71 (defvar gnus-mouse-face-prop 'mouse-face
72 "Property used for highlighting mouse regions.")))
73
74(defvar gnus-tmp-unread)
75(defvar gnus-tmp-replied)
76(defvar gnus-tmp-score-char)
77(defvar gnus-tmp-indentation)
78(defvar gnus-tmp-opening-bracket)
79(defvar gnus-tmp-lines)
80(defvar gnus-tmp-name)
81(defvar gnus-tmp-closing-bracket)
82(defvar gnus-tmp-subject-or-nil)
83(defvar gnus-check-before-posting)
84(defvar gnus-mouse-face)
85(defvar gnus-group-buffer)
86
87(defun gnus-ems-redefine ()
88 (cond
89 ((featurep 'xemacs)
90 (gnus-xmas-redefine))
91
92 ((featurep 'mule)
93 ;; Mule and new Emacs definitions
94
95 ;; [Note] Now there are three kinds of mule implementations,
96 ;; original MULE, XEmacs/mule and Emacs 20+ including
97 ;; MULE features. Unfortunately these APIs are different. In
98 ;; particular, Emacs (including original Mule) and XEmacs are
99 ;; quite different. However, this version of Gnus doesn't support
100 ;; anything other than XEmacs 20+ and Emacs 20.3+.
101
102 ;; Predicates to check are following:
103 ;; (boundp 'MULE) is t only if Mule (original; anything older than
104 ;; Mule 2.3) is running.
105 ;; (featurep 'mule) is t when other mule variants are running.
106
107 ;; It is possible to detect XEmacs/mule by (featurep 'mule) and
108 ;; (featurep 'xemacs). In this case, the implementation for
109 ;; XEmacs/mule may be shareable between XEmacs and XEmacs/mule.
110
111 (defvar gnus-summary-display-table nil
112 "Display table used in summary mode buffers.")
113 (defalias 'gnus-max-width-function 'gnus-mule-max-width-function)
114
115 (when (boundp 'gnus-check-before-posting)
116 (setq gnus-check-before-posting
117 (delq 'long-lines
118 (delq 'control-chars gnus-check-before-posting))))
119
120 (defun gnus-summary-line-format-spec ()
121 (insert gnus-tmp-unread gnus-tmp-replied
122 gnus-tmp-score-char gnus-tmp-indentation)
123 (put-text-property
124 (point)
125 (progn
126 (insert
127 gnus-tmp-opening-bracket
128 (format "%4d: %-20s"
129 gnus-tmp-lines
130 (if (> (length gnus-tmp-name) 20)
131 (truncate-string-to-width gnus-tmp-name 20)
132 gnus-tmp-name))
133 gnus-tmp-closing-bracket)
134 (point))
135 gnus-mouse-face-prop gnus-mouse-face)
136 (insert " " gnus-tmp-subject-or-nil "\n")))))
137
138;; Clone of `appt-select-lowest-window' in appt.el.
139(defun gnus-select-lowest-window ()
140"Select the lowest window on the frame."
141 (let ((lowest-window (selected-window))
142 (bottom-edge (nth 3 (window-edges))))
143 (walk-windows (lambda (w)
144 (let ((next-bottom-edge (nth 3 (window-edges w))))
145 (when (< bottom-edge next-bottom-edge)
146 (setq bottom-edge next-bottom-edge
147 lowest-window w)))))
148 (select-window lowest-window)))
149
150(defun gnus-region-active-p ()
151 "Say whether the region is active."
152 (and (boundp 'transient-mark-mode)
153 transient-mark-mode
154 (boundp 'mark-active)
155 mark-active))
156
157(defun gnus-mark-active-p ()
158 "Non-nil means the mark and region are currently active in this buffer."
159 mark-active) ; aliased to region-exists-p in XEmacs.
160
161(autoload 'gnus-alive-p "gnus-util")
162(autoload 'mm-disable-multibyte "mm-util")
163
164;;; Image functions.
165
166(defun gnus-image-type-available-p (type)
167 (and (fboundp 'image-type-available-p)
168 (if (fboundp 'display-images-p)
169 (display-images-p)
170 t)
171 (image-type-available-p type)))
172
173(defun gnus-create-image (file &optional type data-p &rest props)
174 (let ((face (plist-get props :face)))
175 (when face
176 (setq props (plist-put props :foreground (face-foreground face)))
177 (setq props (plist-put props :background (face-background face))))
178 (ignore-errors
179 (apply 'create-image file type data-p props))))
180
181(defun gnus-put-image (glyph &optional string category)
182 (let ((point (point)))
183 (insert-image glyph (or string " "))
184 (put-text-property point (point) 'gnus-image-category category)
185 (unless string
186 (put-text-property (1- (point)) (point)
187 'gnus-image-text-deletable t))
188 glyph))
189
190(defun gnus-remove-image (image &optional category)
191 "Remove the image matching IMAGE and CATEGORY found first."
192 (let ((start (point-min))
193 val end)
194 (while (and (not end)
195 (or (setq val (get-text-property start 'display))
196 (and (setq start
197 (next-single-property-change start 'display))
198 (setq val (get-text-property start 'display)))))
199 (setq end (or (next-single-property-change start 'display)
200 (point-max)))
201 (if (and (equal val image)
202 (equal (get-text-property start 'gnus-image-category)
203 category))
204 (progn
205 (put-text-property start end 'display nil)
206 (when (get-text-property start 'gnus-image-text-deletable)
207 (delete-region start end)))
208 (unless (= end (point-max))
209 (setq start end
210 end nil))))))
211
212(defmacro gnus-string-mark-left-to-right (string)
213 (if (fboundp 'bidi-string-mark-left-to-right)
214 `(bidi-string-mark-left-to-right ,string)
215 string))
216
217(eval-and-compile
218 ;; XEmacs does not have window-inside-pixel-edges
219 (defalias 'gnus-window-inside-pixel-edges
220 (if (fboundp 'window-inside-pixel-edges)
221 'window-inside-pixel-edges
222 'window-pixel-edges))
223
224 (if (or (featurep 'emacs) (fboundp 'set-process-plist))
225 (progn ; these exist since Emacs 22.1
226 (defalias 'gnus-set-process-plist 'set-process-plist)
227 (defalias 'gnus-process-plist 'process-plist)
228 (defalias 'gnus-process-get 'process-get)
229 (defalias 'gnus-process-put 'process-put))
230 (defun gnus-set-process-plist (process plist)
231 "Replace the plist of PROCESS with PLIST. Returns PLIST."
232 (put 'gnus-process-plist-internal process plist))
233
234 (defun gnus-process-plist (process)
235 "Return the plist of PROCESS."
236 ;; This form works but can't prevent the plist data from
237 ;; growing infinitely.
238 ;;(get 'gnus-process-plist-internal process)
239 (let* ((plist (symbol-plist 'gnus-process-plist-internal))
240 (tem (memq process plist)))
241 (prog1
242 (cadr tem)
243 ;; Remove it from the plist data.
244 (when tem
245 (if (eq plist tem)
246 (progn
247 (setcar plist (caddr plist))
248 (setcdr plist (or (cdddr plist) '(nil))))
249 (setcdr (nthcdr (- (length plist) (length tem) 1) plist)
250 (cddr tem)))))))
251
252 (defun gnus-process-get (process propname)
253 "Return the value of PROCESS' PROPNAME property.
254This is the last value stored with `(gnus-process-put PROCESS PROPNAME VALUE)'."
255 (plist-get (gnus-process-plist process) propname))
256
257 (defun gnus-process-put (process propname value)
258 "Change PROCESS' PROPNAME property to VALUE.
259It can be retrieved with `(gnus-process-get PROCESS PROPNAME)'."
260 (gnus-set-process-plist process
261 (plist-put (gnus-process-plist process)
262 propname value)))))
263
264(provide 'gnus-ems)
265
266;;; gnus-ems.el ends here
diff --git a/lisp/gnus/gnus-sync.el b/lisp/gnus/gnus-sync.el
deleted file mode 100644
index 8a3e45aff32..00000000000
--- a/lisp/gnus/gnus-sync.el
+++ /dev/null
@@ -1,917 +0,0 @@
1;;; gnus-sync.el --- synchronization facility for Gnus
2
3;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
4
5;; Author: Ted Zlatanov <tzz@lifelogs.com>
6;; Keywords: news synchronization nntp nnrss
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software: you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22
23;;; Commentary:
24
25;; This is the gnus-sync.el package.
26
27;; Put this in your startup file (~/.gnus.el for instance)
28
29;; possibilities for gnus-sync-backend:
30;; Tramp over SSH: /ssh:user@host:/path/to/filename
31;; ...or any other file Tramp and Emacs can handle...
32
33;; (setq gnus-sync-backend "/remote:/path.gpg" ; will use Tramp+EPA if loaded
34;; gnus-sync-global-vars '(gnus-newsrc-last-checked-date)
35;; gnus-sync-newsrc-groups '("nntp" "nnrss"))
36;; gnus-sync-newsrc-offsets '(2 3))
37;; against a LeSync server (beware the vampire LeSync, who knows your newsrc)
38
39;; (setq gnus-sync-backend '(lesync "http://lesync.info:5984/tzz")
40;; gnus-sync-newsrc-groups '("nntp" "nnrss"))
41
42;; What's a LeSync server?
43
44;; 1. install CouchDB, set up a real server admin user, and create a
45;; database, e.g. "tzz" and save the URL,
46;; e.g. http://lesync.info:5984/tzz
47
48;; 2. run `M-: (gnus-sync-lesync-setup "http://lesync.info:5984/tzz" "tzzadmin" "mypassword" "mysalt" t t)'
49
50;; (If you run it more than once, you have to remove the entry from
51;; _users yourself. This is intentional. This sets up a database
52;; admin for the "tzz" database, distinct from the server admin
53;; user in (1) above.)
54
55;; That's it, you can start using http://lesync.info:5984/tzz in your
56;; gnus-sync-backend as a LeSync backend. Fan fiction about the
57;; vampire LeSync is welcome.
58
59;; You may not want to expose a CouchDB install to the Big Bad
60;; Internet, especially if your love of all things furry would be thus
61;; revealed. Make sure it's not accessible by unauthorized users and
62;; guests, at least.
63
64;; If you want to try it out, I will create a test DB for you under
65;; http://lesync.info:5984/yourfavoritedbname
66
67;; TODO:
68
69;; - after gnus-sync-read, the message counts look wrong until you do
70;; `g'. So it's not run automatically, you have to call it with M-x
71;; gnus-sync-read
72
73;; - use gnus-after-set-mark-hook and gnus-before-update-mark-hook to
74;; catch the mark updates
75
76;; - repositioning of groups within topic after a LeSync sync is a
77;; weird sort of bubble sort ("buttle" sort: the old entry ends up
78;; at the rear of the list); you will eventually end up with the
79;; right order after calling `gnus-sync-read' a bunch of times.
80
81;; - installing topics and groups is inefficient and annoying, lots of
82;; prompts could be avoided
83
84;;; Code:
85
86(eval-when-compile (require 'cl))
87(require 'json)
88(require 'gnus)
89(require 'gnus-start)
90(require 'gnus-util)
91
92(defvar gnus-topic-alist) ;; gnus-group.el
93(autoload 'gnus-group-topic "gnus-topic")
94
95(defgroup gnus-sync nil
96 "The Gnus synchronization facility."
97 :version "24.1"
98 :group 'gnus)
99
100(defcustom gnus-sync-newsrc-groups '("nntp" "nnrss")
101 "List of groups to be synchronized in the gnus-newsrc-alist.
102The group names are matched, they don't have to be fully
103qualified. Typically you would choose all of these. That's the
104default because there is no active sync backend by default, so
105this setting is harmless until the user chooses a sync backend."
106 :group 'gnus-sync
107 :type '(repeat regexp))
108
109(defcustom gnus-sync-newsrc-offsets '(2 3)
110 "List of per-group data to be synchronized."
111 :group 'gnus-sync
112 :version "24.4"
113 :type '(set (const :tag "Read ranges" 2)
114 (const :tag "Marks" 3)))
115
116(defcustom gnus-sync-global-vars nil
117 "List of global variables to be synchronized.
118You may want to sync `gnus-newsrc-last-checked-date' but pretty
119much any symbol is fair game. You could additionally sync
120`gnus-newsrc-alist', `gnus-server-alist', `gnus-topic-topology',
121and `gnus-topic-alist'. Also see `gnus-variable-list'."
122 :group 'gnus-sync
123 :type '(repeat (choice (variable :tag "A known variable")
124 (symbol :tag "Any symbol"))))
125
126(defcustom gnus-sync-backend nil
127 "The synchronization backend."
128 :group 'gnus-sync
129 :type '(radio (const :format "None" nil)
130 (list :tag "Sync server"
131 (const :format "LeSync Server API" lesync)
132 (string :tag "URL of a CouchDB database for API access"))
133 (string :tag "Sync to a file")))
134
135(defvar gnus-sync-newsrc-loader nil
136 "Carrier for newsrc data")
137
138(defcustom gnus-sync-file-encrypt-to nil
139 "If non-nil, set `epa-file-encrypt-to' from this for encrypting the Sync file."
140 :version "24.4"
141 :type '(choice string (repeat string))
142 :group 'gnus-sync)
143
144(defcustom gnus-sync-lesync-name (system-name)
145 "The LeSync name for this machine."
146 :group 'gnus-sync
147 :version "24.3"
148 :type 'string)
149
150(defcustom gnus-sync-lesync-install-topics 'ask
151 "Should LeSync install the recorded topics?"
152 :group 'gnus-sync
153 :version "24.3"
154 :type '(choice (const :tag "Never Install" nil)
155 (const :tag "Always Install" t)
156 (const :tag "Ask Me Once" ask)))
157
158(defvar gnus-sync-lesync-props-hash (make-hash-table :test 'equal)
159 "LeSync props, keyed by group name")
160
161(defvar gnus-sync-lesync-design-prefix "/_design/lesync"
162 "The LeSync design prefix for CouchDB")
163
164(defvar gnus-sync-lesync-security-object "/_security"
165 "The LeSync security object for CouchDB")
166
167(defun gnus-sync-lesync-parse ()
168 "Parse the result of a LeSync request."
169 (goto-char (point-min))
170 (condition-case nil
171 (when (search-forward-regexp "^$" nil t)
172 (json-read))
173 (error
174 (gnus-message
175 1
176 "gnus-sync-lesync-parse: Could not read the LeSync response!")
177 nil)))
178
179(defun gnus-sync-lesync-call (url method headers &optional kvdata)
180 "Make an access request to URL using KVDATA and METHOD.
181KVDATA must be an alist."
182 (let ((url-request-method method)
183 (url-request-extra-headers headers)
184 (url-request-data (if kvdata (json-encode kvdata) nil)))
185 (with-current-buffer (url-retrieve-synchronously url)
186 (let ((data (gnus-sync-lesync-parse)))
187 (gnus-message 12 "gnus-sync-lesync-call: %s URL %s sent %S got %S"
188 method url `((headers . ,headers) (data ,kvdata)) data)
189 (kill-buffer (current-buffer))
190 data))))
191
192(defun gnus-sync-lesync-PUT (url headers &optional data)
193 (gnus-sync-lesync-call url "PUT" headers data))
194
195(defun gnus-sync-lesync-POST (url headers &optional data)
196 (gnus-sync-lesync-call url "POST" headers data))
197
198(defun gnus-sync-lesync-GET (url headers &optional data)
199 (gnus-sync-lesync-call url "GET" headers data))
200
201(defun gnus-sync-lesync-DELETE (url headers &optional data)
202 (gnus-sync-lesync-call url "DELETE" headers data))
203
204;; this is not necessary with newer versions of json.el but 1.2 or older
205;; (which are in Emacs 24.1 and earlier) need it
206(defun gnus-sync-json-alist-p (list)
207 "Non-null if and only if LIST is an alist."
208 (while (consp list)
209 (setq list (if (consp (car list))
210 (cdr list)
211 'not-alist)))
212 (null list))
213
214;; this is not necessary with newer versions of json.el but 1.2 or older
215;; (which are in Emacs 24.1 and earlier) need it
216(defun gnus-sync-json-plist-p (list)
217 "Non-null if and only if LIST is a plist."
218 (while (consp list)
219 (setq list (if (and (keywordp (car list))
220 (consp (cdr list)))
221 (cddr list)
222 'not-plist)))
223 (null list))
224
225; (gnus-sync-lesync-setup "http://lesync.info:5984/tzz" "tzzadmin" "mypassword" "mysalt" t t)
226; (gnus-sync-lesync-setup "http://lesync.info:5984/tzz")
227
228(defun gnus-sync-lesync-setup (url &optional user password salt reader admin)
229 (interactive "sEnter URL to set up: ")
230 "Set up the LeSync database at URL.
231Install USER as a READER and/or an ADMIN in the security object
232under \"_security\", and in the CouchDB \"_users\" table using
233PASSWORD and SALT. Only one USER is thus supported for now.
234When SALT is nil, a random one will be generated using `random'."
235 (let* ((design-url (concat url gnus-sync-lesync-design-prefix))
236 (security-object (concat url "/_security"))
237 (user-record `((names . [,user]) (roles . [])))
238 (couch-user-name (format "org.couchdb.user:%s" user))
239 (salt (or salt (sha1 (format "%s" (random)))))
240 (couch-user-record
241 `((_id . ,couch-user-name)
242 (type . user)
243 (name . ,(format "%s" user))
244 (roles . [])
245 (salt . ,salt)
246 (password_sha . ,(when password
247 (sha1
248 (format "%s%s" password salt))))))
249 (rev (progn
250 (gnus-sync-lesync-find-prop 'rev design-url design-url)
251 (gnus-sync-lesync-get-prop 'rev design-url)))
252 (latest-func "function(head,req)
253{
254 var tosend = [];
255 var row;
256 var ftime = (req.query['ftime'] || 0);
257 while (row = getRow())
258 {
259 if (row.value['float-time'] > ftime)
260 {
261 var s = row.value['_id'];
262 if (s) tosend.push('\"'+s.replace('\"', '\\\"')+'\"');
263 }
264 }
265 send('['+tosend.join(',') + ']');
266}")
267;; <key>read</key>
268;; <dict>
269;; <key>de.alt.fan.ipod</key>
270;; <array>
271;; <integer>1</integer>
272;; <integer>2</integer>
273;; <dict>
274;; <key>start</key>
275;; <integer>100</integer>
276;; <key>length</key>
277;; <integer>100</integer>
278;; </dict>
279;; </array>
280;; </dict>
281 (xmlplistread-func "function(head, req) {
282 var row;
283 start({ 'headers': { 'Content-Type': 'text/xml' } });
284
285 send('<dict>');
286 send('<key>read</key>');
287 send('<dict>');
288 while(row = getRow())
289 {
290 var read = row.value.read;
291 if (read && read[0] && read[0] == 'invlist')
292 {
293 send('<key>'+row.key+'</key>');
294 //send('<invlist>'+read+'</invlist>');
295 send('<array>');
296
297 var from = 0;
298 var flip = false;
299
300 for (var i = 1; i < read.length && read[i]; i++)
301 {
302 var cur = read[i];
303 if (flip)
304 {
305 if (from == cur-1)
306 {
307 send('<integer>'+read[i]+'</integer>');
308 }
309 else
310 {
311 send('<dict>');
312 send('<key>start</key>');
313 send('<integer>'+from+'</integer>');
314 send('<key>end</key>');
315 send('<integer>'+(cur-1)+'</integer>');
316 send('</dict>');
317 }
318
319 }
320 flip = ! flip;
321 from = cur;
322 }
323 send('</array>');
324 }
325 }
326
327 send('</dict>');
328 send('</dict>');
329}
330")
331 (subs-func "function(doc){emit([doc._id, doc.source], doc._rev);}")
332 (revs-func "function(doc){emit(doc._id, doc._rev);}")
333 (bytimesubs-func "function(doc)
334{emit([(doc['float-time']||0), doc._id], doc._rev);}")
335 (bytime-func "function(doc)
336{emit([(doc['float-time']||0), doc._id], doc);}")
337 (groups-func "function(doc){emit(doc._id, doc);}"))
338 (and (if user
339 (and (assq 'ok (gnus-sync-lesync-PUT
340 security-object
341 nil
342 (append (and reader
343 (list `(readers . ,user-record)))
344 (and admin
345 (list `(admins . ,user-record))))))
346 (assq 'ok (gnus-sync-lesync-PUT
347 (concat (file-name-directory url)
348 "_users/"
349 couch-user-name)
350 nil
351 couch-user-record)))
352 t)
353 (assq 'ok (gnus-sync-lesync-PUT
354 design-url
355 nil
356 `(,@(when rev (list (cons '_rev rev)))
357 (lists . ((latest . ,latest-func)
358 (xmlplistread . ,xmlplistread-func)))
359 (views . ((subs . ((map . ,subs-func)))
360 (revs . ((map . ,revs-func)))
361 (bytimesubs . ((map . ,bytimesubs-func)))
362 (bytime . ((map . ,bytime-func)))
363 (groups . ((map . ,groups-func)))))))))))
364
365(defun gnus-sync-lesync-find-prop (prop url key)
366 "Retrieve a PROPerty of a document KEY at URL.
367Calls `gnus-sync-lesync-set-prop'.
368For the 'rev PROP, uses '_rev against the document."
369 (gnus-sync-lesync-set-prop
370 prop key (cdr (assq (if (eq prop 'rev) '_rev prop)
371 (gnus-sync-lesync-GET url nil)))))
372
373(defun gnus-sync-lesync-set-prop (prop key val)
374 "Update the PROPerty of document KEY at URL to VAL.
375Updates `gnus-sync-lesync-props-hash'."
376 (puthash (format "%s.%s" key prop) val gnus-sync-lesync-props-hash))
377
378(defun gnus-sync-lesync-get-prop (prop key)
379 "Get the PROPerty of KEY from `gnus-sync-lesync-props-hash'."
380 (gethash (format "%s.%s" key prop) gnus-sync-lesync-props-hash))
381
382(defun gnus-sync-deep-print (data)
383 (let* ((print-quoted t)
384 (print-readably t)
385 (print-escape-multibyte nil)
386 (print-escape-nonascii t)
387 (print-length nil)
388 (print-level nil)
389 (print-circle nil)
390 (print-escape-newlines t))
391 (format "%S" data)))
392
393(defun gnus-sync-newsrc-loader-builder (&optional only-modified)
394 (let* ((entries (cdr gnus-newsrc-alist))
395 entry name ret)
396 (while entries
397 (setq entry (pop entries)
398 name (car entry))
399 (when (gnus-grep-in-list name gnus-sync-newsrc-groups)
400 (if only-modified
401 (when (not (equal (gnus-sync-deep-print entry)
402 (gnus-sync-lesync-get-prop 'checksum name)))
403 (gnus-message 9 "%s: add %s, it's modified"
404 "gnus-sync-newsrc-loader-builder" name)
405 (push entry ret))
406 (push entry ret))))
407 ret))
408
409; (json-encode (gnus-sync-range2invlist '((1 . 47137) (47139 . 47714) 48129 48211 49231 49281 49342 49473 49475 49502)))
410(defun gnus-sync-range2invlist (ranges)
411 (append '(invlist)
412 (let ((ranges (delq nil ranges))
413 ret range from to)
414 (while ranges
415 (setq range (pop ranges))
416 (if (atom range)
417 (setq from range
418 to range)
419 (setq from (car range)
420 to (cdr range)))
421 (push from ret)
422 (push (1+ to) ret))
423 (reverse ret))))
424
425; (let* ((d '((1 . 47137) (47139 . 47714) 48129 48211 49231 49281 49342 49473 49475 49502)) (j (format "%S" (gnus-sync-invlist2range (gnus-sync-range2invlist d))))) (or (equal (format "%S" d) j) j))
426(defun gnus-sync-invlist2range (inv)
427 (setq inv (append inv nil))
428 (if (equal (format "%s" (car inv)) "invlist")
429 (let ((i (cdr inv))
430 (start 0)
431 ret cur top flip)
432 (while i
433 (setq cur (pop i))
434 (when flip
435 (setq top (1- cur))
436 (if (= start top)
437 (push start ret)
438 (push (cons start top) ret)))
439 (setq flip (not flip))
440 (setq start cur))
441 (reverse ret))
442 inv))
443
444(defun gnus-sync-position (search list &optional test)
445 "Find the position of SEARCH in LIST using TEST, defaulting to `eq'."
446 (let ((pos 0)
447 (test (or test 'eq)))
448 (while (and list (not (funcall test (car list) search)))
449 (pop list)
450 (incf pos))
451 (if (funcall test (car list) search) pos nil)))
452
453(defun gnus-sync-topic-group-position (group topic-name)
454 (gnus-sync-position
455 group (cdr (assoc topic-name gnus-topic-alist)) 'equal))
456
457(defun gnus-sync-fix-topic-group-position (group topic-name position)
458 (unless (equal position (gnus-sync-topic-group-position group topic-name))
459 (let* ((loc "gnus-sync-fix-topic-group-position")
460 (groups (delete group (cdr (assoc topic-name gnus-topic-alist))))
461 (position (min position (1- (length groups))))
462 (old (nth position groups)))
463 (when (and old (not (equal old group)))
464 (setf (nth position groups) group)
465 (setcdr (assoc topic-name gnus-topic-alist)
466 (append groups (list old)))
467 (gnus-message 9 "%s: %s moved to %d, swap with %s"
468 loc group position old)))))
469
470(defun gnus-sync-lesync-pre-save-group-entry (url nentry &rest passed-props)
471 (let* ((loc "gnus-sync-lesync-save-group-entry")
472 (k (car nentry))
473 (revision (gnus-sync-lesync-get-prop 'rev k))
474 (sname gnus-sync-lesync-name)
475 (topic (gnus-group-topic k))
476 (topic-offset (gnus-sync-topic-group-position k topic))
477 (sources (gnus-sync-lesync-get-prop 'source k)))
478 ;; set the revision so we don't have a conflict
479 `(,@(when revision
480 (list (cons '_rev revision)))
481 (_id . ,k)
482 ;; the time we saved
483 ,@passed-props
484 ;; add our name to the sources list for this key
485 (source ,@(if (member gnus-sync-lesync-name sources)
486 sources
487 (cons gnus-sync-lesync-name sources)))
488 ,(cons 'level (nth 1 nentry))
489 ,@(if topic (list (cons 'topic topic)) nil)
490 ,@(if topic-offset (list (cons 'topic-offset topic-offset)) nil)
491 ;; the read marks
492 ,(cons 'read (gnus-sync-range2invlist (nth 2 nentry)))
493 ;; the other marks
494 ,@(delq nil (mapcar (lambda (mark-entry)
495 (gnus-message 12 "%s: prep param %s in %s"
496 loc
497 (car mark-entry)
498 (nth 3 nentry))
499 (if (listp (cdr mark-entry))
500 (cons (car mark-entry)
501 (gnus-sync-range2invlist
502 (cdr mark-entry)))
503 (progn ; else this is not a list
504 (gnus-message 9 "%s: non-list param %s in %s"
505 loc
506 (car mark-entry)
507 (nth 3 nentry))
508 nil)))
509 (nth 3 nentry))))))
510
511(defun gnus-sync-lesync-post-save-group-entry (url entry)
512 (let* ((loc "gnus-sync-lesync-post-save-group-entry")
513 (k (cdr (assq 'id entry))))
514 (cond
515 ;; success!
516 ((and (assq 'rev entry) (assq 'id entry))
517 (progn
518 (gnus-sync-lesync-set-prop 'rev k (cdr (assq 'rev entry)))
519 (gnus-sync-lesync-set-prop 'checksum
520 k
521 (gnus-sync-deep-print
522 (assoc k gnus-newsrc-alist)))
523 (gnus-message 9 "%s: successfully synced %s to %s"
524 loc k url)))
525 ;; specifically check for document conflicts
526 ((equal "conflict" (format "%s" (cdr-safe (assq 'error entry))))
527 (gnus-error
528 1
529 "%s: use `%s' to resolve the conflict synchronizing %s to %s: %s"
530 loc "gnus-sync-read" k url (cdr (assq 'reason entry))))
531 ;; generic errors
532 ((assq 'error entry)
533 (gnus-error 1 "%s: got error while synchronizing %s to %s: %s"
534 loc k url (cdr (assq 'reason entry))))
535
536 (t
537 (gnus-message 2 "%s: unknown sync status after %s to %s: %S"
538 loc k url entry)))
539 (assoc 'error entry)))
540
541(defun gnus-sync-lesync-groups-builder (url)
542 (let ((u (concat url gnus-sync-lesync-design-prefix "/_view/groups")))
543 (cdr (assq 'rows (gnus-sync-lesync-GET u nil)))))
544
545(defun gnus-sync-subscribe-group (name)
546 "Subscribe to group NAME. Returns NAME on success, nil otherwise."
547 (gnus-subscribe-newsgroup name))
548
549(defun gnus-sync-lesync-read-group-entry (url name entry &rest passed-props)
550 "Read ENTRY information for NAME. Returns NAME if successful.
551Skips entries whose sources don't contain
552`gnus-sync-lesync-name'. When the alist PASSED-PROPS has a
553`subscribe-all' element that evaluates to true, we attempt to
554subscribe to unknown groups. The user is also allowed to delete
555unwanted groups via the LeSync URL."
556 (let* ((loc "gnus-sync-lesync-read-group-entry")
557 (entry (gnus-sync-lesync-normalize-group-entry entry passed-props))
558 (subscribe-all (cdr (assq 'subscribe-all passed-props)))
559 (sources (cdr (assq 'source entry)))
560 (rev (cdr (assq 'rev entry)))
561 (in-sources (member gnus-sync-lesync-name sources))
562 (known (assoc name gnus-newsrc-alist))
563 cell)
564 (unless known
565 (if (and subscribe-all
566 (y-or-n-p (format "Subscribe to group %s?" name)))
567 (setq known (gnus-sync-subscribe-group name)
568 in-sources t)
569 ;; else...
570 (when (y-or-n-p (format "Delete group %s from server?" name))
571 (if (equal name (gnus-sync-lesync-delete-group url name))
572 (gnus-message 1 "%s: removed group %s from server %s"
573 loc name url)
574 (gnus-error 1 "%s: could not remove group %s from server %s"
575 loc name url)))))
576 (when known
577 (unless in-sources
578 (setq in-sources
579 (y-or-n-p
580 (format "Read group %s even though %s is not in sources %S?"
581 name gnus-sync-lesync-name (or sources ""))))))
582 (when rev
583 (gnus-sync-lesync-set-prop 'rev name rev))
584
585 ;; if the source matches AND we have this group
586 (if (and known in-sources)
587 (progn
588 (gnus-message 10 "%s: reading LeSync entry %s, sources %S"
589 loc name sources)
590 (while entry
591 (setq cell (pop entry))
592 (let ((k (car cell))
593 (val (cdr cell)))
594 (gnus-sync-lesync-set-prop k name val)))
595 name)
596 ;; else...
597 (unless known
598 (gnus-message 5 "%s: ignoring entry %s, it wasn't subscribed. %s"
599 loc name "Call `gnus-sync-read' with C-u to force it."))
600 (unless in-sources
601 (gnus-message 5 "%s: ignoring entry %s, %s not in sources %S"
602 loc name gnus-sync-lesync-name (or sources "")))
603 nil)))
604
605(declare-function gnus-topic-create-topic "gnus-topic"
606 (topic parent &optional previous full-topic))
607(declare-function gnus-topic-enter-dribble "gnus-topic" ())
608
609(defun gnus-sync-lesync-install-group-entry (name)
610 (let* ((master (assoc name gnus-newsrc-alist))
611 (old-topic-name (gnus-group-topic name))
612 (old-topic (assoc old-topic-name gnus-topic-alist))
613 (target-topic-name (gnus-sync-lesync-get-prop 'topic name))
614 (target-topic-offset (gnus-sync-lesync-get-prop 'topic-offset name))
615 (target-topic (assoc target-topic-name gnus-topic-alist))
616 (loc "gnus-sync-lesync-install-group-entry"))
617 (if master
618 (progn
619 (when (eq 'ask gnus-sync-lesync-install-topics)
620 (setq gnus-sync-lesync-install-topics
621 (y-or-n-p "Install topics from LeSync?")))
622 (when (and (eq t gnus-sync-lesync-install-topics)
623 target-topic-name)
624 (if (equal old-topic-name target-topic-name)
625 (gnus-message 12 "%s: %s is already in topic %s"
626 loc name target-topic-name)
627 ;; see `gnus-topic-move-group'
628 (when (and old-topic target-topic)
629 (setcdr old-topic (gnus-delete-first name (cdr old-topic)))
630 (gnus-message 5 "%s: removing %s from topic %s"
631 loc name old-topic-name))
632 (unless target-topic
633 (when (y-or-n-p (format "Create missing topic %s?"
634 target-topic-name))
635 (gnus-topic-create-topic target-topic-name nil)
636 (setq target-topic (assoc target-topic-name
637 gnus-topic-alist))))
638 (if target-topic
639 (prog1
640 (nconc target-topic (list name))
641 (gnus-message 5 "%s: adding %s to topic %s"
642 loc name (car target-topic))
643 (gnus-topic-enter-dribble))
644 (gnus-error 2 "%s: LeSync group %s can't go in missing topic %s"
645 loc name target-topic-name)))
646 (when (and target-topic-offset target-topic)
647 (gnus-sync-fix-topic-group-position
648 name target-topic-name target-topic-offset)))
649 ;; install the subscription level
650 (when (gnus-sync-lesync-get-prop 'level name)
651 (setf (nth 1 master) (gnus-sync-lesync-get-prop 'level name)))
652 ;; install the read and other marks
653 (setf (nth 2 master) (gnus-sync-lesync-get-prop 'read name))
654 (setf (nth 3 master) (gnus-sync-lesync-get-prop 'marks name))
655 (gnus-sync-lesync-set-prop 'checksum
656 name
657 (gnus-sync-deep-print master))
658 nil)
659 (gnus-error 1 "%s: invalid LeSync group %s" loc name)
660 'invalid-name)))
661
662; (gnus-sync-lesync-delete-group (cdr gnus-sync-backend) "nntp+Gmane:gwene.org.slashdot")
663
664(defun gnus-sync-lesync-delete-group (url name)
665 "Returns NAME if successful deleting it from URL, an error otherwise."
666 (interactive "sEnter URL to set up: \rsEnter group name: ")
667 (let* ((u (concat (cadr gnus-sync-backend) "/" (url-hexify-string name)))
668 (del (gnus-sync-lesync-DELETE
669 u
670 `(,@(when (gnus-sync-lesync-get-prop 'rev name)
671 (list (cons "If-Match"
672 (gnus-sync-lesync-get-prop 'rev name))))))))
673 (or (cdr (assq 'id del)) del)))
674
675;;; (gnus-sync-lesync-normalize-group-entry '((subscribe . ["invlist"]) (read . ["invlist"]) (topic-offset . 20) (topic . "news") (level . 6) (source . ["a" "b"]) (float-time . 1319671237.099285) (_rev . "10-edf5107f41e5e6f7f6629d1c0ee172f7") (_id . "nntp+news.net:alt.movies")) '((read-time 1319672156.486414) (subscribe-all nil)))
676
677(defun gnus-sync-lesync-normalize-group-entry (entry &optional passed-props)
678 (let (ret
679 marks
680 cell)
681 (setq entry (append passed-props entry))
682 (while (setq cell (pop entry))
683 (let ((k (car cell))
684 (val (cdr cell)))
685 (cond
686 ((eq k 'read)
687 (push (cons k (gnus-sync-invlist2range val)) ret))
688 ;; we ignore these parameters
689 ((member k '(_id subscribe-all _deleted_conflicts))
690 nil)
691 ((eq k '_rev)
692 (push (cons 'rev val) ret))
693 ((eq k 'source)
694 (push (cons 'source (append val nil)) ret))
695 ((or (eq k 'float-time)
696 (eq k 'level)
697 (eq k 'topic)
698 (eq k 'topic-offset)
699 (eq k 'read-time))
700 (push (cons k val) ret))
701;;; "How often have I said to you that when you have eliminated the
702;;; impossible, whatever remains, however improbable, must be the
703;;; truth?" --Sherlock Holmes
704 ;; everything remaining must be a mark
705 (t (push (cons k (gnus-sync-invlist2range val)) marks)))))
706 (cons (cons 'marks marks) ret)))
707
708(defun gnus-sync-save (&optional force)
709"Save the Gnus sync data to the backend.
710With a prefix, FORCE is set and all groups will be saved."
711 (interactive "P")
712 (cond
713 ((and (listp gnus-sync-backend)
714 (eq (nth 0 gnus-sync-backend) 'lesync)
715 (stringp (nth 1 gnus-sync-backend)))
716
717 ;; refresh the revisions if we're forcing the save
718 (when force
719 (mapc (lambda (entry)
720 (when (and (assq 'key entry)
721 (assq 'value entry))
722 (gnus-sync-lesync-set-prop
723 'rev
724 (cdr (assq 'key entry))
725 (cdr (assq 'value entry)))))
726 ;; the revs view is key = name, value = rev
727 (cdr (assq 'rows (gnus-sync-lesync-GET
728 (concat (nth 1 gnus-sync-backend)
729 gnus-sync-lesync-design-prefix
730 "/_view/revs")
731 nil)))))
732
733 (let* ((ftime (float-time))
734 (url (nth 1 gnus-sync-backend))
735 (entries
736 (mapcar (lambda (entry)
737 (gnus-sync-lesync-pre-save-group-entry
738 (cadr gnus-sync-backend)
739 entry
740 (cons 'float-time ftime)))
741 (gnus-sync-newsrc-loader-builder (not force))))
742 ;; when there are no entries, there's nothing to save
743 (sync (if entries
744 (gnus-sync-lesync-POST
745 (concat url "/_bulk_docs")
746 '(("Content-Type" . "application/json"))
747 `((docs . ,(vconcat entries nil))))
748 (gnus-message
749 2 "gnus-sync-save: nothing to save to the LeSync backend")
750 nil)))
751 (mapcar (lambda (e) (gnus-sync-lesync-post-save-group-entry url e))
752 sync)))
753 ((stringp gnus-sync-backend)
754 (gnus-message 7 "gnus-sync-save: saving to backend %s" gnus-sync-backend)
755 ;; populate gnus-sync-newsrc-loader from all but the first dummy
756 ;; entry in gnus-newsrc-alist whose group matches any of the
757 ;; gnus-sync-newsrc-groups
758 ;; TODO: keep the old contents for groups we don't have!
759 (let ((gnus-sync-newsrc-loader
760 (loop for entry in (cdr gnus-newsrc-alist)
761 when (gnus-grep-in-list
762 (car entry) ;the group name
763 gnus-sync-newsrc-groups)
764 collect (cons (car entry)
765 (mapcar (lambda (offset)
766 (cons offset (nth offset entry)))
767 gnus-sync-newsrc-offsets)))))
768 (with-temp-file gnus-sync-backend
769 (progn
770 (let ((coding-system-for-write gnus-ding-file-coding-system)
771 (standard-output (current-buffer)))
772 (when gnus-sync-file-encrypt-to
773 (set (make-local-variable 'epa-file-encrypt-to)
774 gnus-sync-file-encrypt-to))
775 (princ (format ";; -*- mode:emacs-lisp; coding: %s; -*-\n"
776 gnus-ding-file-coding-system))
777 (princ ";; Gnus sync data v. 0.0.1\n")
778 ;; TODO: replace with `gnus-sync-deep-print'
779 (let* ((print-quoted t)
780 (print-readably t)
781 (print-escape-multibyte nil)
782 (print-escape-nonascii t)
783 (print-length nil)
784 (print-level nil)
785 (print-circle nil)
786 (print-escape-newlines t)
787 (variables (cons 'gnus-sync-newsrc-loader
788 gnus-sync-global-vars))
789 variable)
790 (while variables
791 (if (and (boundp (setq variable (pop variables)))
792 (symbol-value variable))
793 (progn
794 (princ "\n(setq ")
795 (princ (symbol-name variable))
796 (princ " '")
797 (prin1 (symbol-value variable))
798 (princ ")\n"))
799 (princ "\n;;; skipping empty variable ")
800 (princ (symbol-name variable)))))
801 (gnus-message
802 7
803 "gnus-sync-save: stored variables %s and %d groups in %s"
804 gnus-sync-global-vars
805 (length gnus-sync-newsrc-loader)
806 gnus-sync-backend)
807
808 ;; Idea from Dan Christensen <jdc@chow.mat.jhu.edu>
809 ;; Save the .eld file with extra line breaks.
810 (gnus-message 8 "gnus-sync-save: adding whitespace to %s"
811 gnus-sync-backend)
812 (save-excursion
813 (goto-char (point-min))
814 (while (re-search-forward "^(\\|(\\\"" nil t)
815 (replace-match "\n\\&" t))
816 (goto-char (point-min))
817 (while (re-search-forward " $" nil t)
818 (replace-match "" t t))))))))
819 ;; the pass-through case: gnus-sync-backend is not a known choice
820 (nil)))
821
822(defun gnus-sync-read (&optional subscribe-all)
823 "Load the Gnus sync data from the backend.
824With a prefix, SUBSCRIBE-ALL is set and unknown groups will be subscribed."
825 (interactive "P")
826 (when gnus-sync-backend
827 (gnus-message 7 "gnus-sync-read: loading from backend %s" gnus-sync-backend)
828 (cond
829 ((and (listp gnus-sync-backend)
830 (eq (nth 0 gnus-sync-backend) 'lesync)
831 (stringp (nth 1 gnus-sync-backend)))
832 (let ((errored nil)
833 name ftime)
834 (mapc (lambda (entry)
835 (setq name (cdr (assq 'id entry)))
836 ;; set ftime the FIRST time through this loop, that
837 ;; way it reflects the time we FINISHED reading
838 (unless ftime (setq ftime (float-time)))
839
840 (unless errored
841 (setq errored
842 (when (equal name
843 (gnus-sync-lesync-read-group-entry
844 (nth 1 gnus-sync-backend)
845 name
846 (cdr (assq 'value entry))
847 `(read-time ,ftime)
848 `(subscribe-all ,subscribe-all)))
849 (gnus-sync-lesync-install-group-entry
850 (cdr (assq 'id entry)))))))
851 (gnus-sync-lesync-groups-builder (nth 1 gnus-sync-backend)))))
852
853 ((stringp gnus-sync-backend)
854 ;; read data here...
855 (if (or debug-on-error debug-on-quit)
856 (load gnus-sync-backend nil t)
857 (condition-case var
858 (load gnus-sync-backend nil t)
859 (error
860 (error "Error in %s: %s" gnus-sync-backend (cadr var)))))
861 (let ((valid-count 0)
862 invalid-groups)
863 (dolist (node gnus-sync-newsrc-loader)
864 (if (gnus-gethash (car node) gnus-newsrc-hashtb)
865 (progn
866 (incf valid-count)
867 (loop for store in (cdr node)
868 do (setf (nth (car store)
869 (assoc (car node) gnus-newsrc-alist))
870 (cdr store))))
871 (push (car node) invalid-groups)))
872 (gnus-message
873 7
874 "gnus-sync-read: loaded %d groups (out of %d) from %s"
875 valid-count (length gnus-sync-newsrc-loader)
876 gnus-sync-backend)
877 (when invalid-groups
878 (gnus-message
879 7
880 "gnus-sync-read: skipped %d groups (out of %d) from %s"
881 (length invalid-groups)
882 (length gnus-sync-newsrc-loader)
883 gnus-sync-backend)
884 (gnus-message 9 "gnus-sync-read: skipped groups: %s"
885 (mapconcat 'identity invalid-groups ", ")))))
886 (nil))
887
888 (gnus-message 9 "gnus-sync-read: remaking the newsrc hashtable")
889 (gnus-make-hashtable-from-newsrc-alist)))
890
891;;;###autoload
892(defun gnus-sync-initialize ()
893"Initialize the Gnus sync facility."
894 (interactive)
895 (gnus-message 5 "Initializing the sync facility")
896 (gnus-sync-install-hooks))
897
898;;;###autoload
899(defun gnus-sync-install-hooks ()
900 "Install the sync hooks."
901 (interactive)
902 ;; (add-hook 'gnus-get-new-news-hook 'gnus-sync-read)
903 ;; (add-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read)
904 (add-hook 'gnus-save-newsrc-hook 'gnus-sync-save))
905
906(defun gnus-sync-unload-hook ()
907 "Uninstall the sync hooks."
908 (interactive)
909 (remove-hook 'gnus-save-newsrc-hook 'gnus-sync-save))
910
911(add-hook 'gnus-sync-unload-hook 'gnus-sync-unload-hook)
912
913(when gnus-sync-backend (gnus-sync-initialize))
914
915(provide 'gnus-sync)
916
917;;; gnus-sync.el ends here
diff --git a/lisp/gnus/messcompat.el b/lisp/gnus/messcompat.el
deleted file mode 100644
index f54dabd53a8..00000000000
--- a/lisp/gnus/messcompat.el
+++ /dev/null
@@ -1,91 +0,0 @@
1;;; messcompat.el --- making message mode compatible with mail mode
2
3;; Copyright (C) 1996-2017 Free Software Foundation, Inc.
4
5;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
6;; Keywords: mail, news
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software: you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22
23;;; Commentary:
24
25;; This file tries to provide backward compatibility with sendmail.el
26;; for Message mode. It should be used by simply adding
27;;
28;; (require 'messcompat)
29;;
30;; to the .emacs file. Loading it after Message mode has been
31;; loaded will have no effect.
32
33;;; Code:
34
35(require 'sendmail)
36
37(defvar message-from-style mail-from-style
38 "*Specifies how \"From\" headers look.
39
40If nil, they contain just the return address like:
41 king@grassland.com
42If `parens', they look like:
43 king@grassland.com (Elvis Parsley)
44If `angles', they look like:
45 Elvis Parsley <king@grassland.com>
46
47Otherwise, most addresses look like `angles', but they look like
48`parens' if `angles' would need quoting and `parens' would not.")
49
50(defvar message-interactive mail-interactive
51 "Non-nil means when sending a message wait for and display errors.
52nil means let mailer mail back a message to report errors.")
53
54(defvar message-setup-hook mail-setup-hook
55 "Normal hook, run each time a new outgoing message is initialized.
56The function `message-setup' runs this hook.")
57
58(if (boundp 'mail-mode-hook)
59 (defvar message-mode-hook mail-mode-hook
60 "Hook run in message mode buffers."))
61
62(defvar message-indentation-spaces mail-indentation-spaces
63 "*Number of spaces to insert at the beginning of each cited line.
64Used by `message-yank-original' via `message-yank-cite'.")
65
66(defvar message-signature mail-signature
67 "*String to be inserted at the end of the message buffer.
68If t, the `message-signature-file' file will be inserted instead.
69If a function, the result from the function will be used instead.
70If a form, the result from the form will be used instead.")
71
72;; Deleted the autoload cookie because this crashes in loaddefs.el.
73(defvar message-signature-file mail-signature-file
74 "*File containing the text inserted at end of the message buffer.")
75
76(defvar message-default-headers mail-default-headers
77 "*A string containing header lines to be inserted in outgoing messages.
78It is inserted before you edit the message, so you can edit or delete
79these lines.")
80
81(defvar message-send-hook mail-send-hook
82 "Hook run before sending messages.")
83
84(defvar message-send-mail-function send-mail-function
85 "Function to call to send the current buffer as mail.
86The headers should be delimited by a line whose contents match the
87variable `mail-header-separator'.")
88
89(provide 'messcompat)
90
91;;; messcompat.el ends here
diff --git a/lisp/nxml/nxml-glyph.el b/lisp/nxml/nxml-glyph.el
deleted file mode 100644
index a0e9b6f3557..00000000000
--- a/lisp/nxml/nxml-glyph.el
+++ /dev/null
@@ -1,423 +0,0 @@
1;;; nxml-glyph.el --- glyph-handling for nxml-mode
2
3;; Copyright (C) 2003, 2007-2017 Free Software Foundation, Inc.
4
5;; Author: James Clark
6;; Keywords: wp, hypermedia, languages, XML
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software: you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22
23;;; Commentary:
24
25;; The entry point to this file is `nxml-glyph-display-string'.
26;; The current implementation is heuristic due to a lack of
27;; Emacs primitives necessary to implement it properly. The user
28;; can tweak the heuristics using `nxml-glyph-set-functions'.
29
30;;; Code:
31
32(defconst nxml-ascii-glyph-set
33 [(#x0020 . #x007E)])
34
35(defconst nxml-latin1-glyph-set
36 [(#x0020 . #x007E)
37 (#x00A0 . #x00FF)])
38
39;; These were generated by using nxml-insert-target-repertoire-glyph-set
40;; on the TARGET[123] files in
41;; http://www.cl.cam.ac.uk/~mgk25/download/ucs-fonts.tar.gz
42
43(defconst nxml-misc-fixed-1-glyph-set
44 [(#x0020 . #x007E)
45 (#x00A0 . #x00FF)
46 (#x0100 . #x017F)
47 #x018F #x0192
48 (#x0218 . #x021B)
49 #x0259
50 (#x02C6 . #x02C7)
51 (#x02D8 . #x02DD)
52 (#x0374 . #x0375)
53 #x037A #x037E
54 (#x0384 . #x038A)
55 #x038C
56 (#x038E . #x03A1)
57 (#x03A3 . #x03CE)
58 (#x0401 . #x040C)
59 (#x040E . #x044F)
60 (#x0451 . #x045C)
61 (#x045E . #x045F)
62 (#x0490 . #x0491)
63 (#x05D0 . #x05EA)
64 (#x1E02 . #x1E03)
65 (#x1E0A . #x1E0B)
66 (#x1E1E . #x1E1F)
67 (#x1E40 . #x1E41)
68 (#x1E56 . #x1E57)
69 (#x1E60 . #x1E61)
70 (#x1E6A . #x1E6B)
71 (#x1E80 . #x1E85)
72 (#x1EF2 . #x1EF3)
73 (#x2010 . #x2022)
74 #x2026 #x2030
75 (#x2039 . #x203A)
76 #x20AC #x2116 #x2122 #x2126
77 (#x215B . #x215E)
78 (#x2190 . #x2193)
79 #x2260
80 (#x2264 . #x2265)
81 (#x23BA . #x23BD)
82 (#x2409 . #x240D)
83 #x2424 #x2500 #x2502 #x250C #x2510 #x2514 #x2518 #x251C #x2524 #x252C #x2534 #x253C #x2592 #x25C6 #x266A #xFFFD]
84 "Glyph set for TARGET1 glyph repertoire of misc-fixed-* font.
85This repertoire is supported for the bold and oblique fonts.")
86
87(defconst nxml-misc-fixed-2-glyph-set
88 [(#x0020 . #x007E)
89 (#x00A0 . #x00FF)
90 (#x0100 . #x017F)
91 #x018F #x0192
92 (#x01FA . #x01FF)
93 (#x0218 . #x021B)
94 #x0259
95 (#x02C6 . #x02C7)
96 #x02C9
97 (#x02D8 . #x02DD)
98 (#x0300 . #x0311)
99 (#x0374 . #x0375)
100 #x037A #x037E
101 (#x0384 . #x038A)
102 #x038C
103 (#x038E . #x03A1)
104 (#x03A3 . #x03CE)
105 #x03D1
106 (#x03D5 . #x03D6)
107 #x03F1
108 (#x0401 . #x040C)
109 (#x040E . #x044F)
110 (#x0451 . #x045C)
111 (#x045E . #x045F)
112 (#x0490 . #x0491)
113 (#x05D0 . #x05EA)
114 (#x1E02 . #x1E03)
115 (#x1E0A . #x1E0B)
116 (#x1E1E . #x1E1F)
117 (#x1E40 . #x1E41)
118 (#x1E56 . #x1E57)
119 (#x1E60 . #x1E61)
120 (#x1E6A . #x1E6B)
121 (#x1E80 . #x1E85)
122 (#x1EF2 . #x1EF3)
123 (#x2010 . #x2022)
124 #x2026 #x2030
125 (#x2032 . #x2034)
126 (#x2039 . #x203A)
127 #x203C #x203E #x2044
128 (#x2070 . #x2071)
129 (#x2074 . #x208E)
130 (#x20A3 . #x20A4)
131 #x20A7 #x20AC
132 (#x20D0 . #x20D7)
133 #x2102 #x2105 #x2113
134 (#x2115 . #x2116)
135 #x211A #x211D #x2122 #x2124 #x2126 #x212E
136 (#x215B . #x215E)
137 (#x2190 . #x2195)
138 (#x21A4 . #x21A8)
139 (#x21D0 . #x21D5)
140 (#x2200 . #x2209)
141 (#x220B . #x220C)
142 #x220F
143 (#x2211 . #x2213)
144 #x2215
145 (#x2218 . #x221A)
146 (#x221D . #x221F)
147 #x2221
148 (#x2224 . #x222B)
149 #x222E #x223C #x2243 #x2245
150 (#x2248 . #x2249)
151 #x2259
152 (#x225F . #x2262)
153 (#x2264 . #x2265)
154 (#x226A . #x226B)
155 (#x2282 . #x228B)
156 #x2295 #x2297
157 (#x22A4 . #x22A7)
158 (#x22C2 . #x22C3)
159 #x22C5 #x2300 #x2302
160 (#x2308 . #x230B)
161 #x2310
162 (#x2320 . #x2321)
163 (#x2329 . #x232A)
164 (#x23BA . #x23BD)
165 (#x2409 . #x240D)
166 #x2424 #x2500 #x2502 #x250C #x2510 #x2514 #x2518 #x251C #x2524 #x252C #x2534 #x253C
167 (#x254C . #x2573)
168 (#x2580 . #x25A1)
169 (#x25AA . #x25AC)
170 (#x25B2 . #x25B3)
171 #x25BA #x25BC #x25C4 #x25C6
172 (#x25CA . #x25CB)
173 #x25CF
174 (#x25D8 . #x25D9)
175 #x25E6
176 (#x263A . #x263C)
177 #x2640 #x2642 #x2660 #x2663
178 (#x2665 . #x2666)
179 (#x266A . #x266B)
180 (#xFB01 . #xFB02)
181 #xFFFD]
182 "Glyph set for TARGET2 glyph repertoire of the misc-fixed-* fonts.
183This repertoire is supported for the following fonts:
1845x7.bdf 5x8.bdf 6x9.bdf 6x10.bdf 6x12.bdf 7x13.bdf 7x14.bdf clR6x12.bdf")
185
186(defconst nxml-misc-fixed-3-glyph-set
187 [(#x0020 . #x007E)
188 (#x00A0 . #x00FF)
189 (#x0100 . #x01FF)
190 (#x0200 . #x0220)
191 (#x0222 . #x0233)
192 (#x0250 . #x02AD)
193 (#x02B0 . #x02EE)
194 (#x0300 . #x034F)
195 (#x0360 . #x036F)
196 (#x0374 . #x0375)
197 #x037A #x037E
198 (#x0384 . #x038A)
199 #x038C
200 (#x038E . #x03A1)
201 (#x03A3 . #x03CE)
202 (#x03D0 . #x03F6)
203 (#x0400 . #x0486)
204 (#x0488 . #x04CE)
205 (#x04D0 . #x04F5)
206 (#x04F8 . #x04F9)
207 (#x0500 . #x050F)
208 (#x0531 . #x0556)
209 (#x0559 . #x055F)
210 (#x0561 . #x0587)
211 (#x0589 . #x058A)
212 (#x05B0 . #x05B9)
213 (#x05BB . #x05C4)
214 (#x05D0 . #x05EA)
215 (#x05F0 . #x05F4)
216 (#x10D0 . #x10F8)
217 #x10FB
218 (#x1E00 . #x1E9B)
219 (#x1EA0 . #x1EF9)
220 (#x1F00 . #x1F15)
221 (#x1F18 . #x1F1D)
222 (#x1F20 . #x1F45)
223 (#x1F48 . #x1F4D)
224 (#x1F50 . #x1F57)
225 #x1F59 #x1F5B #x1F5D
226 (#x1F5F . #x1F7D)
227 (#x1F80 . #x1FB4)
228 (#x1FB6 . #x1FC4)
229 (#x1FC6 . #x1FD3)
230 (#x1FD6 . #x1FDB)
231 (#x1FDD . #x1FEF)
232 (#x1FF2 . #x1FF4)
233 (#x1FF6 . #x1FFE)
234 (#x2000 . #x200A)
235 (#x2010 . #x2027)
236 (#x202F . #x2052)
237 #x2057
238 (#x205F . #x2063)
239 (#x2070 . #x2071)
240 (#x2074 . #x208E)
241 (#x20A0 . #x20B1)
242 (#x20D0 . #x20EA)
243 (#x2100 . #x213A)
244 (#x213D . #x214B)
245 (#x2153 . #x2183)
246 (#x2190 . #x21FF)
247 (#x2200 . #x22FF)
248 (#x2300 . #x23CE)
249 (#x2400 . #x2426)
250 (#x2440 . #x244A)
251 (#x2500 . #x25FF)
252 (#x2600 . #x2613)
253 (#x2616 . #x2617)
254 (#x2619 . #x267D)
255 (#x2680 . #x2689)
256 (#x27E6 . #x27EB)
257 (#x27F5 . #x27FF)
258 (#x2A00 . #x2A06)
259 #x2A1D #x2A3F #x303F
260 (#xFB00 . #xFB06)
261 (#xFB13 . #xFB17)
262 (#xFB1D . #xFB36)
263 (#xFB38 . #xFB3C)
264 #xFB3E
265 (#xFB40 . #xFB41)
266 (#xFB43 . #xFB44)
267 (#xFB46 . #xFB4F)
268 (#xFE20 . #xFE23)
269 (#xFF61 . #xFF9F)
270 #xFFFD]
271 "Glyph set for TARGET3 glyph repertoire of the misc-fixed-* fonts.
272This repertoire is supported for the following fonts:
2736x13.bdf 8x13.bdf 9x15.bdf 9x18.bdf 10x20.bdf")
274
275(defconst nxml-wgl4-glyph-set
276 [(#x0020 . #x007E)
277 (#x00A0 . #x017F)
278 #x0192
279 (#x01FA . #x01FF)
280 (#x02C6 . #x02C7)
281 #x02C9
282 (#x02D8 . #x02DB)
283 #x02DD
284 (#x0384 . #x038A)
285 #x038C
286 (#x038E . #x03A1)
287 (#x03A3 . #x03CE)
288 (#x0401 . #x040C)
289 (#x040E . #x044F)
290 (#x0451 . #x045C)
291 (#x045E . #x045F)
292 (#x0490 . #x0491)
293 (#x1E80 . #x1E85)
294 (#x1EF2 . #x1EF3)
295 (#x2013 . #x2015)
296 (#x2017 . #x201E)
297 (#x2020 . #x2022)
298 #x2026 #x2030
299 (#x2032 . #x2033)
300 (#x2039 . #x203A)
301 #x203C #x203E #x2044 #x207F
302 (#x20A3 . #x20A4)
303 #x20A7 #x20AC #x2105 #x2113 #x2116 #x2122 #x2126 #x212E
304 (#x215B . #x215E)
305 (#x2190 . #x2195)
306 #x21A8 #x2202 #x2206 #x220F
307 (#x2211 . #x2212)
308 #x2215
309 (#x2219 . #x221A)
310 (#x221E . #x221F)
311 #x2229 #x222B #x2248
312 (#x2260 . #x2261)
313 (#x2264 . #x2265)
314 #x2302 #x2310
315 (#x2320 . #x2321)
316 #x2500 #x2502 #x250C #x2510 #x2514 #x2518 #x251C #x2524
317 #x252C #x2534 #x253C
318 (#x2550 . #x256C)
319 #x2580 #x2584 #x2588 #x258C
320 (#x2590 . #x2593)
321 (#x25A0 . #x25A1)
322 (#x25AA . #x25AC)
323 #x25B2 #x25BA #x25BC #x25C4
324 (#x25CA . #x25CB)
325 #x25CF
326 (#x25D8 . #x25D9)
327 #x25E6
328 (#x263A . #x263C)
329 #x2640 #x2642 #x2660 #x2663
330 (#x2665 . #x2666)
331 (#x266A . #x266B)
332 (#xFB01 . #xFB02)]
333 "Glyph set corresponding to Windows Glyph List 4.")
334
335(defvar nxml-glyph-set-functions nil
336 "Abnormal hook for determining the set of glyphs in a face.
337Each function in this hook is called in turn, unless one of them
338returns non-nil. Each function is called with a single argument
339FACE. If it can determine the set of glyphs representable by
340FACE, it must set the variable `nxml-glyph-set' and return
341non-nil. Otherwise, it must return nil.
342
343The constants `nxml-ascii-glyph-set', `nxml-latin1-glyph-set',
344`nxml-misc-fixed-1-glyph-set', `nxml-misc-fixed-2-glyph-set',
345`nxml-misc-fixed-3-glyph-set' and `nxml-wgl4-glyph-set' are
346predefined for use by `nxml-glyph-set-functions'.")
347
348(define-obsolete-variable-alias 'nxml-glyph-set-hook
349 'nxml-glyph-set-functions "24.3")
350
351(defvar nxml-glyph-set nil
352 "Used by `nxml-glyph-set-functions' to return set of glyphs in a FACE.
353This should dynamically bound by any function that runs
354`nxml-glyph-set-functions'. The value must be either nil representing an
355empty set or a vector. Each member of the vector is either a single
356integer or a cons (FIRST . LAST) representing the range of integers
357from FIRST to LAST. An integer represents a glyph with that Unicode
358code-point. The vector must be ordered.")
359
360(defun nxml-x-set-glyph-set (face)
361 (setq nxml-glyph-set
362 (if (equal (face-attribute face :family) "misc-fixed")
363 nxml-misc-fixed-3-glyph-set
364 nxml-wgl4-glyph-set)))
365
366(defun nxml-w32-set-glyph-set (face)
367 (setq nxml-glyph-set nxml-wgl4-glyph-set))
368
369(defun nxml-window-system-set-glyph-set (face)
370 (setq nxml-glyph-set nxml-latin1-glyph-set))
371
372(defun nxml-terminal-set-glyph-set (face)
373 (setq nxml-glyph-set nxml-ascii-glyph-set))
374
375(add-hook 'nxml-glyph-set-functions
376 (or (cdr (assq window-system
377 '((x . nxml-x-set-glyph-set)
378 (w32 . nxml-w32-set-glyph-set)
379 (nil . nxml-terminal-set-glyph-set))))
380 'nxml-window-system-set-glyph-set)
381 t)
382
383;;;###autoload
384(defun nxml-glyph-display-string (n face)
385 "Return a string that can display a glyph for Unicode code-point N.
386FACE gives the face that will be used for displaying the string.
387Return nil if the face cannot display a glyph for N."
388 (let ((nxml-glyph-set nil))
389 (run-hook-with-args-until-success 'nxml-glyph-set-functions face)
390 (and nxml-glyph-set
391 (nxml-glyph-set-contains-p n nxml-glyph-set)
392 (let ((ch (decode-char 'ucs n)))
393 (and ch (string ch))))))
394
395(defun nxml-glyph-set-contains-p (n v)
396 (let ((start 0)
397 (end (length v))
398 found mid mid-val mid-start-val mid-end-val)
399 (while (> end start)
400 (setq mid (+ start
401 (/ (- end start) 2)))
402 (setq mid-val (aref v mid))
403 (if (consp mid-val)
404 (setq mid-start-val (car mid-val)
405 mid-end-val (cdr mid-val))
406 (setq mid-start-val mid-val
407 mid-end-val mid-val))
408 (cond ((and (<= mid-start-val n)
409 (<= n mid-end-val))
410 (setq found t)
411 (setq start end))
412 ((< n mid-start-val)
413 (setq end mid))
414 (t
415 (setq start
416 (if (eq start mid)
417 end
418 mid)))))
419 found))
420
421(provide 'nxml-glyph)
422
423;;; nxml-glyph.el ends here
diff --git a/lisp/nxml/nxml-uchnm.el b/lisp/nxml/nxml-uchnm.el
deleted file mode 100644
index 06e03688e0f..00000000000
--- a/lisp/nxml/nxml-uchnm.el
+++ /dev/null
@@ -1,251 +0,0 @@
1;;; nxml-uchnm.el --- support for Unicode standard cha names in nxml-mode
2
3;; Copyright (C) 2003, 2007-2017 Free Software Foundation, Inc.
4
5;; Author: James Clark
6;; Keywords: wp, hypermedia, languages, XML
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software: you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22
23;;; Commentary:
24
25;; This enables the use of the character names defined in the Unicode
26;; Standard. The use of the names can be controlled on a per-block
27;; basis, so as both to reduce memory usage and loading time,
28;; and to make completion work better.
29
30;;; Code:
31
32(require 'nxml-mode)
33
34(defconst nxml-unicode-blocks
35 '(("Basic Latin" #x0000 #x007F)
36 ("Latin-1 Supplement" #x0080 #x00FF)
37 ("Latin Extended-A" #x0100 #x017F)
38 ("Latin Extended-B" #x0180 #x024F)
39 ("IPA Extensions" #x0250 #x02AF)
40 ("Spacing Modifier Letters" #x02B0 #x02FF)
41 ("Combining Diacritical Marks" #x0300 #x036F)
42 ("Greek and Coptic" #x0370 #x03FF)
43 ("Cyrillic" #x0400 #x04FF)
44 ("Cyrillic Supplementary" #x0500 #x052F)
45 ("Armenian" #x0530 #x058F)
46 ("Hebrew" #x0590 #x05FF)
47 ("Arabic" #x0600 #x06FF)
48 ("Syriac" #x0700 #x074F)
49 ("Thaana" #x0780 #x07BF)
50 ("Devanagari" #x0900 #x097F)
51 ("Bengali" #x0980 #x09FF)
52 ("Gurmukhi" #x0A00 #x0A7F)
53 ("Gujarati" #x0A80 #x0AFF)
54 ("Oriya" #x0B00 #x0B7F)
55 ("Tamil" #x0B80 #x0BFF)
56 ("Telugu" #x0C00 #x0C7F)
57 ("Kannada" #x0C80 #x0CFF)
58 ("Malayalam" #x0D00 #x0D7F)
59 ("Sinhala" #x0D80 #x0DFF)
60 ("Thai" #x0E00 #x0E7F)
61 ("Lao" #x0E80 #x0EFF)
62 ("Tibetan" #x0F00 #x0FFF)
63 ("Myanmar" #x1000 #x109F)
64 ("Georgian" #x10A0 #x10FF)
65 ("Hangul Jamo" #x1100 #x11FF)
66 ("Ethiopic" #x1200 #x137F)
67 ("Cherokee" #x13A0 #x13FF)
68 ("Unified Canadian Aboriginal Syllabics" #x1400 #x167F)
69 ("Ogham" #x1680 #x169F)
70 ("Runic" #x16A0 #x16FF)
71 ("Tagalog" #x1700 #x171F)
72 ("Hanunoo" #x1720 #x173F)
73 ("Buhid" #x1740 #x175F)
74 ("Tagbanwa" #x1760 #x177F)
75 ("Khmer" #x1780 #x17FF)
76 ("Mongolian" #x1800 #x18AF)
77 ("Latin Extended Additional" #x1E00 #x1EFF)
78 ("Greek Extended" #x1F00 #x1FFF)
79 ("General Punctuation" #x2000 #x206F)
80 ("Superscripts and Subscripts" #x2070 #x209F)
81 ("Currency Symbols" #x20A0 #x20CF)
82 ("Combining Diacritical Marks for Symbols" #x20D0 #x20FF)
83 ("Letterlike Symbols" #x2100 #x214F)
84 ("Number Forms" #x2150 #x218F)
85 ("Arrows" #x2190 #x21FF)
86 ("Mathematical Operators" #x2200 #x22FF)
87 ("Miscellaneous Technical" #x2300 #x23FF)
88 ("Control Pictures" #x2400 #x243F)
89 ("Optical Character Recognition" #x2440 #x245F)
90 ("Enclosed Alphanumerics" #x2460 #x24FF)
91 ("Box Drawing" #x2500 #x257F)
92 ("Block Elements" #x2580 #x259F)
93 ("Geometric Shapes" #x25A0 #x25FF)
94 ("Miscellaneous Symbols" #x2600 #x26FF)
95 ("Dingbats" #x2700 #x27BF)
96 ("Miscellaneous Mathematical Symbols-A" #x27C0 #x27EF)
97 ("Supplemental Arrows-A" #x27F0 #x27FF)
98 ("Braille Patterns" #x2800 #x28FF)
99 ("Supplemental Arrows-B" #x2900 #x297F)
100 ("Miscellaneous Mathematical Symbols-B" #x2980 #x29FF)
101 ("Supplemental Mathematical Operators" #x2A00 #x2AFF)
102 ("CJK Radicals Supplement" #x2E80 #x2EFF)
103 ("Kangxi Radicals" #x2F00 #x2FDF)
104 ("Ideographic Description Characters" #x2FF0 #x2FFF)
105 ("CJK Symbols and Punctuation" #x3000 #x303F)
106 ("Hiragana" #x3040 #x309F)
107 ("Katakana" #x30A0 #x30FF)
108 ("Bopomofo" #x3100 #x312F)
109 ("Hangul Compatibility Jamo" #x3130 #x318F)
110 ("Kanbun" #x3190 #x319F)
111 ("Bopomofo Extended" #x31A0 #x31BF)
112 ("Katakana Phonetic Extensions" #x31F0 #x31FF)
113 ("Enclosed CJK Letters and Months" #x3200 #x32FF)
114 ("CJK Compatibility" #x3300 #x33FF)
115 ("CJK Unified Ideographs Extension A" #x3400 #x4DBF)
116 ;;("CJK Unified Ideographs" #x4E00 #x9FFF)
117 ("Yi Syllables" #xA000 #xA48F)
118 ("Yi Radicals" #xA490 #xA4CF)
119 ;;("Hangul Syllables" #xAC00 #xD7AF)
120 ;;("High Surrogates" #xD800 #xDB7F)
121 ;;("High Private Use Surrogates" #xDB80 #xDBFF)
122 ;;("Low Surrogates" #xDC00 #xDFFF)
123 ;;("Private Use Area" #xE000 #xF8FF)
124 ;;("CJK Compatibility Ideographs" #xF900 #xFAFF)
125 ("Alphabetic Presentation Forms" #xFB00 #xFB4F)
126 ("Arabic Presentation Forms-A" #xFB50 #xFDFF)
127 ("Variation Selectors" #xFE00 #xFE0F)
128 ("Combining Half Marks" #xFE20 #xFE2F)
129 ("CJK Compatibility Forms" #xFE30 #xFE4F)
130 ("Small Form Variants" #xFE50 #xFE6F)
131 ("Arabic Presentation Forms-B" #xFE70 #xFEFF)
132 ("Halfwidth and Fullwidth Forms" #xFF00 #xFFEF)
133 ("Specials" #xFFF0 #xFFFF)
134 ("Old Italic" #x10300 #x1032F)
135 ("Gothic" #x10330 #x1034F)
136 ("Deseret" #x10400 #x1044F)
137 ("Byzantine Musical Symbols" #x1D000 #x1D0FF)
138 ("Musical Symbols" #x1D100 #x1D1FF)
139 ("Mathematical Alphanumeric Symbols" #x1D400 #x1D7FF)
140 ;;("CJK Unified Ideographs Extension B" #x20000 #x2A6DF)
141 ;;("CJK Compatibility Ideographs Supplement" #x2F800 #x2FA1F)
142 ("Tags" #xE0000 #xE007F)
143 ;;("Supplementary Private Use Area-A" #xF0000 #xFFFFF)
144 ;;("Supplementary Private Use Area-B" #x100000 #x10FFFF)
145 )
146 "List of Unicode blocks.
147For each block there is a list (NAME FIRST LAST), where
148NAME is a string giving the official name of the block,
149FIRST is the first code-point and LAST is the last code-point.
150Blocks containing only characters with algorithmic names or no names
151are omitted.")
152
153(defun nxml-unicode-block-char-name-set (name)
154 "Return a symbol for a block whose official Unicode name is NAME.
155The symbol is generated by downcasing and replacing each space
156by a hyphen."
157 (intern (replace-regexp-in-string " " "-" (downcase name))))
158
159;; This is intended to be a superset of the coverage
160;; of existing standard entity sets.
161(defvar nxml-enabled-unicode-blocks-default
162 '(basic-latin
163 latin-1-supplement
164 latin-extended-a
165 latin-extended-b
166 ipa-extensions
167 spacing-modifier-letters
168 combining-diacritical-marks
169 greek-and-coptic
170 cyrillic
171 general-punctuation
172 superscripts-and-subscripts
173 currency-symbols
174 combining-diacritical-marks-for-symbols
175 letterlike-symbols
176 number-forms
177 arrows
178 mathematical-operators
179 miscellaneous-technical
180 control-pictures
181 optical-character-recognition
182 enclosed-alphanumerics
183 box-drawing
184 block-elements
185 geometric-shapes
186 miscellaneous-symbols
187 dingbats
188 miscellaneous-mathematical-symbols-a
189 supplemental-arrows-a
190 supplemental-arrows-b
191 miscellaneous-mathematical-symbols-b
192 supplemental-mathematical-operators
193 cjk-symbols-and-punctuation
194 alphabetic-presentation-forms
195 variation-selectors
196 small-form-variants
197 specials
198 mathematical-alphanumeric-symbols)
199 "Default value for `nxml-enabled-unicode-blocks'.")
200
201(mapc (lambda (block)
202 (nxml-autoload-char-name-set
203 (nxml-unicode-block-char-name-set (car block))
204 (expand-file-name
205 (format "nxml/%05X-%05X"
206 (nth 1 block)
207 (nth 2 block))
208 data-directory)))
209 nxml-unicode-blocks)
210
211;; Internal flag to control whether customize reloads the character tables.
212;; Should be set the first time the
213(defvar nxml-internal-unicode-char-name-sets-enabled nil)
214
215(defcustom nxml-enabled-unicode-blocks nxml-enabled-unicode-blocks-default
216 "List of Unicode blocks for which Unicode character names are enabled.
217Each block is identified by a symbol derived from the name
218of the block by downcasing and replacing each space by a hyphen."
219 :group 'nxml
220 :set (lambda (sym value)
221 (set-default 'nxml-enabled-unicode-blocks value)
222 (when nxml-internal-unicode-char-name-sets-enabled
223 (nxml-enable-unicode-char-name-sets)))
224 :type (cons 'set
225 (mapcar (lambda (block)
226 `(const :tag ,(format "%s (%04X-%04X)"
227 (nth 0 block)
228 (nth 1 block)
229 (nth 2 block))
230 ,(nxml-unicode-block-char-name-set
231 (nth 0 block))))
232 nxml-unicode-blocks)))
233
234;;;###autoload
235(defun nxml-enable-unicode-char-name-sets ()
236 "Enable the use of Unicode standard names for characters.
237The Unicode blocks for which names are enabled is controlled by
238the variable `nxml-enabled-unicode-blocks'."
239 (interactive)
240 (setq nxml-internal-unicode-char-name-sets-enabled t)
241 (mapc (lambda (block)
242 (nxml-disable-char-name-set
243 (nxml-unicode-block-char-name-set (car block))))
244 nxml-unicode-blocks)
245 (mapc (lambda (nameset)
246 (nxml-enable-char-name-set nameset))
247 nxml-enabled-unicode-blocks))
248
249(provide 'nxml-uchnm)
250
251;;; nxml-uchnm.el ends here
diff --git a/lisp/obsolete/awk-mode.el b/lisp/obsolete/awk-mode.el
deleted file mode 100644
index f42043b8fb2..00000000000
--- a/lisp/obsolete/awk-mode.el
+++ /dev/null
@@ -1,124 +0,0 @@
1;;; awk-mode.el --- AWK code editing commands for Emacs
2
3;; Copyright (C) 1988, 1994, 1996, 2000-2017 Free Software Foundation,
4;; Inc.
5
6;; Maintainer: emacs-devel@gnu.org
7;; Keywords: unix, languages
8;; Obsolete-since: 22.1
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software: you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24
25;;; Commentary:
26
27;; Sets up C-mode with support for awk-style #-comments and a lightly
28;; hacked syntax table.
29
30;;; Code:
31
32(defvar awk-mode-syntax-table
33 (let ((st (make-syntax-table)))
34 (modify-syntax-entry ?\\ "\\" st)
35 (modify-syntax-entry ?\n "> " st)
36 (modify-syntax-entry ?\f "> " st)
37 (modify-syntax-entry ?\# "< " st)
38 ;; / can delimit regexes or be a division operator. We assume that it is
39 ;; more commonly used for regexes and fix the remaining cases with
40 ;; `font-lock-syntactic-keywords'.
41 (modify-syntax-entry ?/ "\"" st)
42 (modify-syntax-entry ?* "." st)
43 (modify-syntax-entry ?+ "." st)
44 (modify-syntax-entry ?- "." st)
45 (modify-syntax-entry ?= "." st)
46 (modify-syntax-entry ?% "." st)
47 (modify-syntax-entry ?< "." st)
48 (modify-syntax-entry ?> "." st)
49 (modify-syntax-entry ?& "." st)
50 (modify-syntax-entry ?| "." st)
51 (modify-syntax-entry ?_ "_" st)
52 (modify-syntax-entry ?\' "\"" st)
53 st)
54 "Syntax table in use in `awk-mode' buffers.")
55
56;; Regexps written with help from Peter Galbraith <galbraith@mixing.qc.dfo.ca>.
57(defconst awk-font-lock-keywords
58 (eval-when-compile
59 (list
60 ;;
61 ;; Function names.
62 '("^[ \t]*\\(function\\)\\>[ \t]*\\(\\sw+\\)?"
63 (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
64 ;;
65 ;; Variable names.
66 (cons (regexp-opt
67 '("ARGC" "ARGIND" "ARGV" "CONVFMT" "ENVIRON" "ERRNO"
68 "FIELDWIDTHS" "FILENAME" "FNR" "FS" "IGNORECASE" "NF" "NR"
69 "OFMT" "OFS" "ORS" "RLENGTH" "RS" "RSTART" "SUBSEP") 'words)
70 'font-lock-variable-name-face)
71 ;;
72 ;; Keywords.
73 (regexp-opt
74 '("BEGIN" "END" "break" "continue" "delete" "do" "exit" "else" "for"
75 "getline" "if" "next" "print" "printf" "return" "while") 'words)
76 ;;
77 ;; Builtins.
78 (list (regexp-opt
79 '("atan2" "close" "cos" "ctime" "exp" "gsub" "index" "int"
80 "length" "log" "match" "rand" "sin" "split" "sprintf"
81 "sqrt" "srand" "sub" "substr" "system" "time"
82 "tolower" "toupper") 'words)
83 1 'font-lock-builtin-face)
84 ;;
85 ;; Operators. Is this too much?
86 (cons (regexp-opt '("&&" "||" "<=" "<" ">=" ">" "==" "!=" "!~" "~"))
87 'font-lock-constant-face)
88 ))
89 "Default expressions to highlight in AWK mode.")
90
91(require 'syntax)
92
93(defconst awk-font-lock-syntactic-keywords
94 ;; `/' is mostly used for /.../ regular expressions, but is also
95 ;; used as a division operator. Distinguishing between the two is
96 ;; a pain in the youknowwhat.
97 ;; '(("\\(^\\|[<=>-+*%/!^,~(?:|&]\\)\\s-*\\(/\\)\\([^/\n\\]\\|\\\\.\\)*\\(/\\)"
98 ;; (2 "\"") (4 "\"")))
99 '(("[^<=>-+*%/!^,~(?:|& \t\n\f]\\s-*\\(/\\)"
100 (1 (unless (nth 3 (syntax-ppss (match-beginning 1))) "."))))
101 "Syntactic keywords for `awk-mode'.")
102
103;; No longer autoloaded since it might clobber the autoload directive in CC Mode.
104(define-derived-mode awk-mode c-mode "AWK"
105 "Major mode for editing AWK code.
106This is much like C mode except for the syntax of comments. Its keymap
107inherits from C mode's and it has the same variables for customizing
108indentation. It has its own abbrev table and its own syntax table.
109
110Turning on AWK mode runs `awk-mode-hook'."
111 (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter))
112 (set (make-local-variable 'paragraph-separate) paragraph-start)
113 (set (make-local-variable 'comment-start) "# ")
114 (set (make-local-variable 'comment-end) "")
115 (set (make-local-variable 'comment-start-skip) "#+ *")
116 (setq font-lock-defaults '(awk-font-lock-keywords
117 nil nil ((?_ . "w")) nil
118 (parse-sexp-lookup-properties . t)
119 (font-lock-syntactic-keywords
120 . awk-font-lock-syntactic-keywords))))
121
122(provide 'awk-mode)
123
124;;; awk-mode.el ends here
diff --git a/lisp/obsolete/iso-acc.el b/lisp/obsolete/iso-acc.el
deleted file mode 100644
index a18d4e543f6..00000000000
--- a/lisp/obsolete/iso-acc.el
+++ /dev/null
@@ -1,489 +0,0 @@
1;;; iso-acc.el --- minor mode providing electric accent keys
2
3;; Copyright (C) 1993-1994, 1996, 2001-2017 Free Software Foundation,
4;; Inc.
5
6;; Author: Johan Vromans
7;; Maintainer: emacs-devel@gnu.org
8;; Keywords: i18n
9;; Obsolete-since: 22.1
10
11;; This file is part of GNU Emacs.
12
13;; GNU Emacs is free software: you can redistribute it and/or modify
14;; it under the terms of the GNU General Public License as published by
15;; the Free Software Foundation, either version 3 of the License, or
16;; (at your option) any later version.
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
24;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25
26;;; Commentary:
27
28;; Function `iso-accents-mode' activates a minor mode in which
29;; typewriter "dead keys" are emulated. The purpose of this emulation
30;; is to provide a simple means for inserting accented characters
31;; according to the ISO-8859-1...3 character sets.
32;;
33;; In `iso-accents-mode', pseudo accent characters are used to
34;; introduce accented keys. The pseudo-accent characters are:
35;;
36;; ' (minute) -> acute accent
37;; ` (backtick) -> grave accent
38;; " (second) -> diaeresis
39;; ^ (caret) -> circumflex
40;; ~ (tilde) -> tilde over the character
41;; / (slash) -> slash through the character.
42;; Also: /A is A-with-ring and /E is AE ligature.
43;; These two are enabled only if you set iso-accents-enable
44;; to include them:
45;; . (period) -> dot over the character (some languages only)
46;; , (cedilla) -> cedilla under the character (some languages only)
47;;
48;; The action taken depends on the key that follows the pseudo accent.
49;; In general:
50;;
51;; pseudo-accent + appropriate letter -> accented letter
52;; pseudo-accent + space -> pseudo-accent (except comma and period)
53;; pseudo-accent + pseudo-accent -> accent (if available)
54;; pseudo-accent + other -> pseudo-accent + other
55;;
56;; If the pseudo-accent is followed by anything else than a
57;; self-insert-command, the dead-key code is terminated, the
58;; pseudo-accent inserted ‘as is’ and the bell is rung to signal this.
59;;
60;; Function `iso-accents-mode' can be used to enable the iso accents
61;; minor mode, or disable it.
62
63;; If you want only some of these characters to serve as accents,
64;; add a language to `iso-languages' which specifies the accent characters
65;; that you want, then select the language with `iso-accents-customize'.
66
67;;; Code:
68
69(provide 'iso-acc)
70
71(defgroup iso-acc nil
72 "Minor mode providing electric accent keys."
73 :prefix "iso-accents-"
74 :group 'i18n)
75
76(defcustom iso-accents-insert-offset nonascii-insert-offset
77 "Offset added by ISO Accents mode to character codes 0200 and above."
78 :type 'integer
79 :group 'iso-acc)
80
81(defvar iso-languages
82 '(("catalan"
83 ;; Note this includes some extra characters used in Spanish,
84 ;; on the idea that someone who uses Catalan is likely to use Spanish
85 ;; as well.
86 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
87 (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372)
88 (?\ . ?'))
89 (?` (?A . ?\300) (?E . ?\310) (?O . ?\322)
90 (?a . ?\340) (?e . ?\350) (?o . ?\362)
91 (?\ . ?`))
92 (?\" (?I . ?\317) (?U . ?\334) (?i . ?\357) (?u . ?\374)
93 (?\ . ?\"))
94 (?~ (?C . ?\307) (?N . ?\321) (?c . ?\347) (?n . ?\361)
95 (?> . ?\273) (?< . ?\253) (?! . ?\241) (?? . ?\277)
96 (?\ . ?\~)))
97
98 ("esperanto"
99 (?^ (?H . ?\246) (?J . ?\254) (?h . ?\266) (?j . ?\274) (?C . ?\306)
100 (?G . ?\330) (?S . ?\336) (?c . ?\346) (?g . ?\370) (?s . ?\376)
101 (?^ . ?^) (?\ . ?^))
102 (?~ (?U . ?\335) (?u . ?\375) (?\ . ?~)))
103
104 ("french"
105 (?' (?E . ?\311) (?C . ?\307) (?e . ?\351) (?c . ?\347)
106 (?\ . ?'))
107 (?` (?A . ?\300) (?E . ?\310) (?U . ?\331)
108 (?a . ?\340) (?e . ?\350) (?u . ?\371)
109 (?\ . ?`))
110 (?^ (?A . ?\302) (?E . ?\312) (?I . ?\316) (?O . ?\324) (?U . ?\333)
111 (?a . ?\342) (?e . ?\352) (?i . ?\356) (?o . ?\364) (?u . ?\373)
112 (?\ . ?^))
113 (?\" (?E . ?\313) (?I . ?\317)
114 (?e . ?\353) (?i . ?\357)
115 (?\ . ?\"))
116 (?~ (?< . ?\253) (?> . ?\273) (?C . ?\307) (?c . ?\347)
117 (?\ . ?~))
118 (?, (?C . ?\307) (?c . ?\347) (?\ . ?\,)))
119
120 ("german"
121 (?\" (?A . ?\304) (?O . ?\326) (?U . ?\334)
122 (?a . ?\344) (?o . ?\366) (?u . ?\374) (?s . ?\337) (?\ . ?\")))
123
124 ("irish"
125 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
126 (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372)
127 (?\ . ?')))
128
129 ("portuguese"
130 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
131 (?C . ?\307) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363)
132 (?u . ?\372) (?c . ?\347)
133 (?\ . ?'))
134 (?` (?A . ?\300) (?a . ?\340)
135 (?\ . ?`))
136 (?^ (?A . ?\302) (?E . ?\312) (?O . ?\324)
137 (?a . ?\342) (?e . ?\352) (?o . ?\364)
138 (?\ . ?^))
139 (?\" (?U . ?\334) (?u . ?\374)
140 (?\ . ?\"))
141 (?~ (?A . ?\303) (?O . ?\325) (?a . ?\343) (?o . ?\365)
142 (?C . ?\307) (?N . ?\321) (?c . ?\347) (?n . ?\361)
143 (?\ . ?~))
144 (?, (?c . ?\347) (?C . ?\307) (?, . ?,)))
145
146 ("spanish"
147 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
148 (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372)
149 (?\ . ?'))
150 (?\" (?U . ?\334) (?u . ?\374) (?\ . ?\"))
151 (?\~ (?N . ?\321) (?n . ?\361) (?> . ?\273) (?< . ?\253) (?! . ?\241)
152 (?? . ?\277) (?\ . ?\~)))
153
154 ("latin-1"
155 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
156 (?Y . ?\335) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363)
157 (?u . ?\372) (?y . ?\375) (?' . ?\264)
158 (?\ . ?'))
159 (?` (?A . ?\300) (?E . ?\310) (?I . ?\314) (?O . ?\322) (?U . ?\331)
160 (?a . ?\340) (?e . ?\350) (?i . ?\354) (?o . ?\362) (?u . ?\371)
161 (?` . ?`) (?\ . ?`))
162 (?^ (?A . ?\302) (?E . ?\312) (?I . ?\316) (?O . ?\324) (?U . ?\333)
163 (?a . ?\342) (?e . ?\352) (?i . ?\356) (?o . ?\364) (?u . ?\373)
164 (?^ . ?^) (?\ . ?^))
165 (?\" (?A . ?\304) (?E . ?\313) (?I . ?\317) (?O . ?\326) (?U . ?\334)
166 (?a . ?\344) (?e . ?\353) (?i . ?\357) (?o . ?\366) (?s . ?\337)
167 (?u . ?\374) (?y . ?\377)
168 (?\" . ?\250) (?\ . ?\"))
169 (?~ (?A . ?\303) (?C . ?\307) (?D . ?\320) (?N . ?\321) (?O . ?\325)
170 (?T . ?\336) (?a . ?\343) (?c . ?\347) (?d . ?\360) (?n . ?\361)
171 (?o . ?\365) (?t . ?\376)
172 (?> . ?\273) (?< . ?\253) (?! . ?\241) (?? . ?\277)
173 (?\~ . ?\270) (?\ . ?~))
174 (?/ (?A . ?\305) (?E . ?\306) (?O . ?\330) (?a . ?\345) (?e . ?\346)
175 (?o . ?\370)
176 (?/ . ?\260) (?\ . ?/)))
177
178 ("latin-2" latin-iso8859-2
179 (?' (?A . ?\301) (?C . ?\306) (?D . ?\320) (?E . ?\311) (?I . ?\315)
180 (?L . ?\305) (?N . ?\321) (?O . ?\323) (?R . ?\300) (?S . ?\246)
181 (?U . ?\332) (?Y . ?\335) (?Z . ?\254)
182 (?a . ?\341) (?c . ?\346) (?d . ?\360) (?e . ?\351) (?i . ?\355)
183 (?l . ?\345) (?n . ?\361) (?o . ?\363) (?r . ?\340) (?s . ?\266)
184 (?u . ?\372) (?y . ?\375) (?z . ?\274)
185 (?' . ?\264) (?\ . ?'))
186 (?` (?A . ?\241) (?C . ?\307) (?E . ?\312) (?L . ?\243) (?S . ?\252)
187 (?T . ?\336) (?Z . ?\257)
188 (?a . ?\261) (?l . ?\263) (?c . ?\347) (?e . ?\352) (?s . ?\272)
189 (?t . ?\376) (?z . ?\277)
190 (?` . ?\252)
191 (?. . ?\377) (?\ . ?`))
192 (?^ (?A . ?\302) (?I . ?\316) (?O . ?\324)
193 (?a . ?\342) (?i . ?\356) (?o . ?\364)
194 (?^ . ?^) ; no special code?
195 (?\ . ?^))
196 (?\" (?A . ?\304) (?E . ?\313) (?O . ?\326) (?U . ?\334)
197 (?a . ?\344) (?e . ?\353) (?o . ?\366) (?s . ?\337) (?u . ?\374)
198 (?\" . ?\250)
199 (?\ . ?\"))
200 (?~ (?A . ?\303) (?C . ?\310) (?D . ?\317) (?L . ?\245) (?N . ?\322)
201 (?O . ?\325) (?R . ?\330) (?S . ?\251) (?T . ?\253) (?U . ?\333)
202 (?Z . ?\256)
203 (?a . ?\343) (?c . ?\350) (?d . ?\357) (?l . ?\265) (?n . ?\362)
204 (?o . ?\365) (?r . ?\370) (?s . ?\271) (?t . ?\273) (?u . ?\373)
205 (?z . ?\276)
206 (?v . ?\242) ; v accent
207 (?\~ . ?\242) ; v accent
208 (?\. . ?\270) ; cedilla accent
209 (?\ . ?~)))
210
211 ("latin-3" latin-iso8859-3
212 (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
213 (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372)
214 (?' . ?\264) (?\ . ?'))
215 (?` (?A . ?\300) (?E . ?\310) (?I . ?\314) (?O . ?\322) (?U . ?\331)
216 (?a . ?\340) (?e . ?\350) (?i . ?\354) (?o . ?\362) (?u . ?\371)
217 (?` . ?`) (?\ . ?`))
218 (?^ (?A . ?\302) (?C . ?\306) (?E . ?\312) (?G . ?\330) (?H . ?\246)
219 (?I . ?\316) (?J . ?\254) (?O . ?\324) (?S . ?\336) (?U . ?\333)
220 (?a . ?\342) (?c . ?\346) (?e . ?\352) (?g . ?\370) (?h . ?\266)
221 (?i . ?\356) (?j . ?\274) (?o . ?\364) (?s . ?\376) (?u . ?\373)
222 (?^ . ?^) (?\ . ?^))
223 (?\" (?A . ?\304) (?E . ?\313) (?I . ?\317) (?O . ?\326) (?U . ?\334)
224 (?a . ?\344) (?e . ?\353) (?i . ?\357) (?o . ?\366) (?u . ?\374)
225 (?s . ?\337)
226 (?\" . ?\250) (?\ . ?\"))
227 (?~ (?A . ?\303) (?C . ?\307) (?D . ?\320) (?N . ?\321) (?O . ?\325)
228 (?a . ?\343) (?c . ?\347) (?d . ?\360) (?n . ?\361) (?o . ?\365)
229 (?$ . ?\245) (?S . ?\252) (?s . ?\272) (?G . ?\253) (?g . ?\273)
230 (?U . ?\335) (?u . ?\375) (?` . ?\242)
231 (?~ . ?\270) (?\ . ?~))
232 (?/ (?C . ?\305) (?G . ?\325) (?H . ?\241) (?I . ?\251) (?Z . ?\257)
233 (?c . ?\345) (?g . ?\365) (?h . ?\261) (?i . ?\271) (?z . ?\277)
234 (?r . ?\256)
235 (?. . ?\377) (?# . ?\243) (?$ . ?\244)
236 (?/ . ?\260) (?\ . ?/))
237 (?. (?C . ?\305) (?G . ?\325) (?I . ?\251) (?Z . ?\257)
238 (?c . ?\345) (?g . ?\365) (?z . ?\277))))
239 "List of language-specific customizations for the ISO Accents mode.
240
241Each element of the list is of the form
242
243 (LANGUAGE [CHARSET]
244 (PSEUDO-ACCENT MAPPINGS)
245 (PSEUDO-ACCENT MAPPINGS)
246 ...)
247
248LANGUAGE is a string naming the language.
249CHARSET (which may be omitted) is the symbol name
250 of the character set used in this language.
251 If CHARSET is omitted, latin-iso8859-1 is the default.
252PSEUDO-ACCENT is a char specifying an accent key.
253MAPPINGS are cons cells of the form (CHAR . ISO-CHAR).
254
255The net effect is that the key sequence PSEUDO-ACCENT CHAR is mapped
256to ISO-CHAR on input.")
257
258(defvar iso-language nil
259 "Language for which ISO Accents mode is currently customized.
260Change it with the `iso-accents-customize' function.")
261
262(defvar iso-accents-list nil
263 "Association list for ISO accent combinations, for the chosen language.")
264
265(defcustom iso-accents-mode nil
266 "Non-nil enables ISO Accents mode.
267Setting this variable makes it local to the current buffer.
268See the function `iso-accents-mode'."
269 :type 'boolean
270 :group 'iso-acc)
271(make-variable-buffer-local 'iso-accents-mode)
272
273(defcustom iso-accents-enable '(?' ?` ?^ ?\" ?~ ?/)
274 "List of accent keys that become prefixes in ISO Accents mode.
275The default is (?\\=' ?\\=` ?^ ?\" ?~ ?/), which contains all the supported
276accent keys. If you set this variable to a list in which some of those
277characters are missing, the missing ones do not act as accents.
278
279Note that if you specify a language with `iso-accents-customize',
280that can also turn off certain prefixes (whichever ones are not needed in
281the language you choose)."
282 :type '(repeat character)
283 :group 'iso-acc)
284
285(defun iso-accents-accent-key (prompt)
286 "Modify the following character by adding an accent to it."
287 ;; Pick up the accent character.
288 (if (and iso-accents-mode
289 (memq last-input-event iso-accents-enable))
290 (iso-accents-compose prompt)
291 (vector last-input-event)))
292
293
294;; The iso-accents-compose function is called deep inside Emacs' read
295;; key sequence machinery, so the call to read-event below actually
296;; recurses into that machinery. Doing that does not cause any
297;; problem on its own, but read-event will have marked the window's
298;; display matrix to be accurate -- which is broken by the subsequent
299;; call to delete-region. Therefore, we must call force-window-update
300;; after delete-region to explicitly clear the accurate state of the
301;; window's display matrix.
302
303(defun iso-accents-compose (prompt)
304 (let* ((first-char last-input-event)
305 (list (assq first-char iso-accents-list))
306 ;; Wait for the second key and look up the combination.
307 (second-char (if (or prompt
308 (not (eq (key-binding "a")
309 'self-insert-command))
310 ;; Not at start of a key sequence.
311 (> (length (this-single-command-keys)) 1)
312 ;; Called from anything but the command loop.
313 this-command)
314 (progn
315 (message "%s%c"
316 (or prompt "Compose with ")
317 first-char)
318 (read-event))
319 (insert first-char)
320 (prog1 (read-event)
321 (delete-region (1- (point)) (point))
322 ;; Display is no longer up-to-date.
323 (force-window-update (selected-window)))))
324 (entry (cdr (assq second-char list))))
325 (if entry
326 ;; Found it: return the mapped char
327 (vector
328 (if (and enable-multibyte-characters
329 (>= entry ?\200))
330 (+ iso-accents-insert-offset entry)
331 entry))
332 ;; Otherwise, advance and schedule the second key for execution.
333 (push second-char unread-command-events)
334 (vector first-char))))
335
336;; It is a matter of taste if you want the minor mode indicated
337;; in the mode line...
338;; If so, uncomment the next four lines.
339;; (or (assq 'iso-accents-mode minor-mode-alist)
340;; (setq minor-mode-alist
341;; (append minor-mode-alist
342;; '((iso-accents-mode " ISO-Acc")))))
343
344;;;###autoload
345(defun iso-accents-mode (&optional arg)
346 "Toggle ISO Accents mode, in which accents modify the following letter.
347This permits easy insertion of accented characters according to ISO-8859-1.
348When Iso-accents mode is enabled, accent character keys
349\(\\=`, \\=', \", ^, / and ~) do not self-insert; instead, they modify the following
350letter key so that it inserts an ISO accented letter.
351
352You can customize ISO Accents mode to a particular language
353with the command `iso-accents-customize'.
354
355Special combinations: ~c gives a c with cedilla,
356~d gives an Icelandic eth (d with dash).
357~t gives an Icelandic thorn.
358\"s gives German sharp s.
359/a gives a with ring.
360/e gives an a-e ligature.
361~< and ~> give guillemots.
362~! gives an inverted exclamation mark.
363~? gives an inverted question mark.
364
365With an argument, a positive argument enables ISO Accents mode,
366and a negative argument disables it."
367
368 (interactive "P")
369
370 (if (if arg
371 ;; Negative arg means switch it off.
372 (<= (prefix-numeric-value arg) 0)
373 ;; No arg means toggle.
374 iso-accents-mode)
375 (setq iso-accents-mode nil)
376
377 ;; Enable electric accents.
378 (setq iso-accents-mode t)))
379
380(defun iso-accents-customize (language)
381 "Customize the ISO accents machinery for a particular language.
382It selects the customization based on the specifications in the
383`iso-languages' variable."
384 (interactive (list (completing-read "Language: " iso-languages nil t)))
385 (let ((table (cdr (assoc language iso-languages)))
386 all-accents tail)
387 (if (not table)
388 (error "Unknown language `%s'" language)
389 (setq iso-accents-insert-offset (- (make-char (if (symbolp (car table))
390 (car table)
391 'latin-iso8859-1))
392 128))
393 (if (symbolp (car table))
394 (setq table (cdr table)))
395 (setq iso-language language
396 iso-accents-list table)
397 (if key-translation-map
398 (substitute-key-definition
399 'iso-accents-accent-key nil key-translation-map)
400 (setq key-translation-map (make-sparse-keymap)))
401 ;; Set up translations for all the characters that are used as
402 ;; accent prefixes in this language.
403 (setq tail iso-accents-list)
404 (while tail
405 (define-key key-translation-map (vector (car (car tail)))
406 'iso-accents-accent-key)
407 (setq tail (cdr tail))))))
408
409(defun iso-accentuate (start end)
410 "Convert two-character sequences in region into accented characters.
411Noninteractively, this operates on text from START to END.
412This uses the same conversion that ISO Accents mode uses for type-in."
413 (interactive "r")
414 (save-excursion
415 (save-restriction
416 (narrow-to-region start end)
417 (goto-char start)
418 (forward-char 1)
419 (let (entry)
420 (while (< (point) end)
421 (if (and (memq (preceding-char) iso-accents-enable)
422 (setq entry (cdr (assq (following-char) (assq (preceding-char) iso-accents-list)))))
423 (progn
424 (forward-char -1)
425 (delete-char 2)
426 (insert entry)
427 (setq end (1- end)))
428 (forward-char 1)))))))
429
430(defun iso-accent-rassoc-unit (value alist)
431 (let (elt acc)
432 (while (and alist (not elt))
433 (setq acc (car (car alist))
434 elt (car (rassq value (cdr (car alist))))
435 alist (cdr alist)))
436 (if elt
437 (cons acc elt))))
438
439(defun iso-unaccentuate (start end)
440 "Convert accented characters in the region into two-character sequences.
441Noninteractively, this operates on text from START to END.
442This uses the opposite of the conversion done by ISO Accents mode for type-in."
443 (interactive "r")
444 (save-excursion
445 (save-restriction
446 (narrow-to-region start end)
447 (goto-char start)
448 (let (entry)
449 (while (< (point) end)
450 (if (and (> (following-char) 127)
451 (setq entry (iso-accent-rassoc-unit (following-char)
452 iso-accents-list)))
453 (progn
454 (delete-char 1)
455 (insert (car entry) (cdr entry))
456 (setq end (1+ end)))
457 (forward-char 1)))))))
458
459(defun iso-deaccentuate (start end)
460 "Convert accented characters in the region into unaccented characters.
461Noninteractively, this operates on text from START to END."
462 (interactive "r")
463 (save-excursion
464 (save-restriction
465 (narrow-to-region start end)
466 (goto-char start)
467 (let (entry)
468 (while (< (point) end)
469 (if (and (> (following-char) 127)
470 (setq entry (iso-accent-rassoc-unit (following-char)
471 iso-accents-list)))
472 (progn
473 (delete-char 1)
474 (insert (cdr entry)))
475 (forward-char 1)))))))
476
477;; Set up the default settings.
478(iso-accents-customize "latin-1")
479
480;; Use Iso-Accents mode in the minibuffer
481;; if it was in use in the previous buffer.
482(defun iso-acc-minibuf-setup ()
483 (setq iso-accents-mode
484 (with-current-buffer (window-buffer minibuffer-scroll-window)
485 iso-accents-mode)))
486
487(add-hook 'minibuffer-setup-hook 'iso-acc-minibuf-setup)
488
489;;; iso-acc.el ends here
diff --git a/lisp/obsolete/iso-insert.el b/lisp/obsolete/iso-insert.el
deleted file mode 100644
index 1075ae03e0c..00000000000
--- a/lisp/obsolete/iso-insert.el
+++ /dev/null
@@ -1,630 +0,0 @@
1;;; iso-insert.el --- insert functions for ISO 8859/1
2
3;; Copyright (C) 1987, 1994, 2001-2017 Free Software Foundation, Inc.
4
5;; Author: Howard Gayle
6;; Maintainer: emacs-devel@gnu.org
7;; Keywords: i18n
8;; Obsolete-since: 22.1
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software: you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24
25;;; Commentary:
26
27;; Provides keys for inserting ISO Latin-1 characters. They use the
28;; prefix key C-x 8. Type C-x 8 C-h for a list.
29
30;;; Code:
31
32(defun insert-no-break-space ()
33 (interactive "*")
34 (insert ?\ )
35)
36
37(defun insert-inverted-exclamation-mark ()
38 (interactive "*")
39 (insert ?\¡)
40)
41
42(defun insert-cent-sign ()
43 (interactive "*")
44 (insert ?\¢)
45)
46
47(defun insert-pound-sign ()
48 (interactive "*")
49 (insert ?\£)
50)
51
52(defun insert-general-currency-sign ()
53 (interactive "*")
54 (insert ?\¤)
55)
56
57(defun insert-yen-sign ()
58 (interactive "*")
59 (insert ?\¥)
60)
61
62(defun insert-broken-vertical-line ()
63 (interactive "*")
64 (insert ?\¦)
65)
66
67(defun insert-section-sign ()
68 (interactive "*")
69 (insert ?\§)
70)
71
72(defun insert-diaeresis ()
73 (interactive "*")
74 (insert ?\¨)
75)
76
77(defun insert-copyright-sign ()
78 (interactive "*")
79 (insert ?\©)
80)
81
82(defun insert-ordinal-indicator-feminine ()
83 (interactive "*")
84 (insert ?\ª)
85)
86
87(defun insert-angle-quotation-mark-left ()
88 (interactive "*")
89 (insert ?\«)
90)
91
92(defun insert-not-sign ()
93 (interactive "*")
94 (insert ?\¬)
95)
96
97(defun insert-soft-hyphen ()
98 (interactive "*")
99 (insert ?\­)
100)
101
102(defun insert-registered-sign ()
103 (interactive "*")
104 (insert ?\®)
105)
106
107(defun insert-macron ()
108 (interactive "*")
109 (insert ?\¯)
110)
111
112(defun insert-degree-sign ()
113 (interactive "*")
114 (insert ?\°)
115)
116
117(defun insert-plus-or-minus-sign ()
118 (interactive "*")
119 (insert ?\±)
120)
121
122(defun insert-superscript-two ()
123 (interactive "*")
124 (insert ?\²)
125)
126
127(defun insert-superscript-three ()
128 (interactive "*")
129 (insert ?\³)
130)
131
132(defun insert-acute-accent ()
133 (interactive "*")
134 (insert ?\´)
135)
136
137(defun insert-micro-sign ()
138 (interactive "*")
139 (insert ?\µ)
140)
141
142(defun insert-pilcrow ()
143 (interactive "*")
144 (insert ?\¶)
145)
146
147(defun insert-middle-dot ()
148 (interactive "*")
149 (insert ?\·)
150)
151
152(defun insert-cedilla ()
153 (interactive "*")
154 (insert ?\¸)
155)
156
157(defun insert-superscript-one ()
158 (interactive "*")
159 (insert ?\¹)
160)
161
162(defun insert-ordinal-indicator-masculine ()
163 (interactive "*")
164 (insert ?\º)
165)
166
167(defun insert-angle-quotation-mark-right ()
168 (interactive "*")
169 (insert ?\»)
170)
171
172(defun insert-fraction-one-quarter ()
173 (interactive "*")
174 (insert ?\¼)
175)
176
177(defun insert-fraction-one-half ()
178 (interactive "*")
179 (insert ?\½)
180)
181
182(defun insert-fraction-three-quarters ()
183 (interactive "*")
184 (insert ?\¾)
185)
186
187(defun insert-inverted-question-mark ()
188 (interactive "*")
189 (insert ?\¿)
190)
191
192(defun insert-A-grave ()
193 (interactive "*")
194 (insert ?\À)
195)
196
197(defun insert-A-acute ()
198 (interactive "*")
199 (insert ?\Á)
200)
201
202(defun insert-A-circumflex ()
203 (interactive "*")
204 (insert ?\Â)
205)
206
207(defun insert-A-tilde ()
208 (interactive "*")
209 (insert ?\Ã)
210)
211
212(defun insert-A-umlaut ()
213 (interactive "*")
214 (insert ?\Ä)
215)
216
217(defun insert-A-ring ()
218 (interactive "*")
219 (insert ?\Å)
220)
221
222(defun insert-AE ()
223 (interactive "*")
224 (insert ?\Æ)
225)
226
227(defun insert-C-cedilla ()
228 (interactive "*")
229 (insert ?\Ç)
230)
231
232(defun insert-E-grave ()
233 (interactive "*")
234 (insert ?\È)
235)
236
237(defun insert-E-acute ()
238 (interactive "*")
239 (insert ?\É)
240)
241
242(defun insert-E-circumflex ()
243 (interactive "*")
244 (insert ?\Ê)
245)
246
247(defun insert-E-umlaut ()
248 (interactive "*")
249 (insert ?\Ë)
250)
251
252(defun insert-I-grave ()
253 (interactive "*")
254 (insert ?\Ì)
255)
256
257(defun insert-I-acute ()
258 (interactive "*")
259 (insert ?\Í)
260)
261
262(defun insert-I-circumflex ()
263 (interactive "*")
264 (insert ?\Î)
265)
266
267(defun insert-I-umlaut ()
268 (interactive "*")
269 (insert ?\Ï)
270)
271
272(defun insert-D-stroke ()
273 (interactive "*")
274 (insert ?\Ð)
275)
276
277(defun insert-N-tilde ()
278 (interactive "*")
279 (insert ?\Ñ)
280)
281
282(defun insert-O-grave ()
283 (interactive "*")
284 (insert ?\Ò)
285)
286
287(defun insert-O-acute ()
288 (interactive "*")
289 (insert ?\Ó)
290)
291
292(defun insert-O-circumflex ()
293 (interactive "*")
294 (insert ?\Ô)
295)
296
297(defun insert-O-tilde ()
298 (interactive "*")
299 (insert ?\Õ)
300)
301
302(defun insert-O-umlaut ()
303 (interactive "*")
304 (insert ?\Ö)
305)
306
307(defun insert-multiplication-sign ()
308 (interactive "*")
309 (insert ?\×)
310)
311
312(defun insert-O-slash ()
313 (interactive "*")
314 (insert ?\Ø)
315)
316
317(defun insert-U-grave ()
318 (interactive "*")
319 (insert ?\Ù)
320)
321
322(defun insert-U-acute ()
323 (interactive "*")
324 (insert ?\Ú)
325)
326
327(defun insert-U-circumflex ()
328 (interactive "*")
329 (insert ?\Û)
330)
331
332(defun insert-U-umlaut ()
333 (interactive "*")
334 (insert ?\Ü)
335)
336
337(defun insert-Y-acute ()
338 (interactive "*")
339 (insert ?\Ý)
340)
341
342(defun insert-THORN ()
343 (interactive "*")
344 (insert ?\Þ)
345)
346
347(defun insert-ss ()
348 (interactive "*")
349 (insert ?\ß)
350)
351
352(defun insert-a-grave ()
353 (interactive "*")
354 (insert ?\à)
355)
356
357(defun insert-a-acute ()
358 (interactive "*")
359 (insert ?\á)
360)
361
362(defun insert-a-circumflex ()
363 (interactive "*")
364 (insert ?\â)
365)
366
367(defun insert-a-tilde ()
368 (interactive "*")
369 (insert ?\ã)
370)
371
372(defun insert-a-umlaut ()
373 (interactive "*")
374 (insert ?\ä)
375)
376
377(defun insert-a-ring ()
378 (interactive "*")
379 (insert ?\å)
380)
381
382(defun insert-ae ()
383 (interactive "*")
384 (insert ?\æ)
385)
386
387(defun insert-c-cedilla ()
388 (interactive "*")
389 (insert ?\ç)
390)
391
392(defun insert-e-grave ()
393 (interactive "*")
394 (insert ?\è)
395)
396
397(defun insert-e-acute ()
398 (interactive "*")
399 (insert ?\é)
400)
401
402(defun insert-e-circumflex ()
403 (interactive "*")
404 (insert ?\ê)
405)
406
407(defun insert-e-umlaut ()
408 (interactive "*")
409 (insert ?\ë)
410)
411
412(defun insert-i-grave ()
413 (interactive "*")
414 (insert ?\ì)
415)
416
417(defun insert-i-acute ()
418 (interactive "*")
419 (insert ?\í)
420)
421
422(defun insert-i-circumflex ()
423 (interactive "*")
424 (insert ?\î)
425)
426
427(defun insert-i-umlaut ()
428 (interactive "*")
429 (insert ?\ï)
430)
431
432(defun insert-d-stroke ()
433 (interactive "*")
434 (insert ?\ð)
435)
436
437(defun insert-n-tilde ()
438 (interactive "*")
439 (insert ?\ñ)
440)
441
442(defun insert-o-grave ()
443 (interactive "*")
444 (insert ?\ò)
445)
446
447(defun insert-o-acute ()
448 (interactive "*")
449 (insert ?\ó)
450)
451
452(defun insert-o-circumflex ()
453 (interactive "*")
454 (insert ?\ô)
455)
456
457(defun insert-o-tilde ()
458 (interactive "*")
459 (insert ?\õ)
460)
461
462(defun insert-o-umlaut ()
463 (interactive "*")
464 (insert ?\ö)
465)
466
467(defun insert-division-sign ()
468 (interactive "*")
469 (insert ?\÷)
470)
471
472(defun insert-o-slash ()
473 (interactive "*")
474 (insert ?\ø)
475)
476
477(defun insert-u-grave ()
478 (interactive "*")
479 (insert ?\ù)
480)
481
482(defun insert-u-acute ()
483 (interactive "*")
484 (insert ?\ú)
485)
486
487(defun insert-u-circumflex ()
488 (interactive "*")
489 (insert ?\û)
490)
491
492(defun insert-u-umlaut ()
493 (interactive "*")
494 (insert ?\ü)
495)
496
497(defun insert-y-acute ()
498 (interactive "*")
499 (insert ?\ý)
500)
501
502(defun insert-thorn ()
503 (interactive "*")
504 (insert ?\þ)
505)
506
507(defun insert-y-umlaut ()
508 (interactive "*")
509 (insert ?\ÿ)
510)
511
512(defvar 8859-1-map nil "Keymap for ISO 8859/1 character insertion.")
513(if 8859-1-map nil
514 (setq 8859-1-map (make-keymap))
515 (define-key 8859-1-map " " 'insert-no-break-space)
516 (define-key 8859-1-map "!" 'insert-inverted-exclamation-mark)
517 (define-key 8859-1-map "\"" (make-sparse-keymap))
518 (define-key 8859-1-map "\"\"" 'insert-diaeresis)
519 (define-key 8859-1-map "\"A" 'insert-A-umlaut)
520 (define-key 8859-1-map "\"E" 'insert-E-umlaut)
521 (define-key 8859-1-map "\"I" 'insert-I-umlaut)
522 (define-key 8859-1-map "\"O" 'insert-O-umlaut)
523 (define-key 8859-1-map "\"U" 'insert-U-umlaut)
524 (define-key 8859-1-map "\"a" 'insert-a-umlaut)
525 (define-key 8859-1-map "\"e" 'insert-e-umlaut)
526 (define-key 8859-1-map "\"i" 'insert-i-umlaut)
527 (define-key 8859-1-map "\"o" 'insert-o-umlaut)
528 (define-key 8859-1-map "\"u" 'insert-u-umlaut)
529 (define-key 8859-1-map "\"y" 'insert-y-umlaut)
530 (define-key 8859-1-map "'" (make-sparse-keymap))
531 (define-key 8859-1-map "''" 'insert-acute-accent)
532 (define-key 8859-1-map "'A" 'insert-A-acute)
533 (define-key 8859-1-map "'E" 'insert-E-acute)
534 (define-key 8859-1-map "'I" 'insert-I-acute)
535 (define-key 8859-1-map "'O" 'insert-O-acute)
536 (define-key 8859-1-map "'U" 'insert-U-acute)
537 (define-key 8859-1-map "'Y" 'insert-Y-acute)
538 (define-key 8859-1-map "'a" 'insert-a-acute)
539 (define-key 8859-1-map "'e" 'insert-e-acute)
540 (define-key 8859-1-map "'i" 'insert-i-acute)
541 (define-key 8859-1-map "'o" 'insert-o-acute)
542 (define-key 8859-1-map "'u" 'insert-u-acute)
543 (define-key 8859-1-map "'y" 'insert-y-acute)
544 (define-key 8859-1-map "$" 'insert-general-currency-sign)
545 (define-key 8859-1-map "+" 'insert-plus-or-minus-sign)
546 (define-key 8859-1-map "," (make-sparse-keymap))
547 (define-key 8859-1-map ",," 'insert-cedilla)
548 (define-key 8859-1-map ",C" 'insert-C-cedilla)
549 (define-key 8859-1-map ",c" 'insert-c-cedilla)
550 (define-key 8859-1-map "-" 'insert-soft-hyphen)
551 (define-key 8859-1-map "." 'insert-middle-dot)
552 (define-key 8859-1-map "/" (make-sparse-keymap))
553 (define-key 8859-1-map "//" 'insert-division-sign)
554 (define-key 8859-1-map "/O" 'insert-O-slash)
555 (define-key 8859-1-map "/o" 'insert-o-slash)
556 (define-key 8859-1-map "1" (make-sparse-keymap))
557 (define-key 8859-1-map "1/" (make-sparse-keymap))
558 (define-key 8859-1-map "1/2" 'insert-fraction-one-half)
559 (define-key 8859-1-map "1/4" 'insert-fraction-one-quarter)
560 (define-key 8859-1-map "3" (make-sparse-keymap))
561 (define-key 8859-1-map "3/" (make-sparse-keymap))
562 (define-key 8859-1-map "3/4" 'insert-fraction-three-quarters)
563 (define-key 8859-1-map "<" 'insert-angle-quotation-mark-left)
564 (define-key 8859-1-map "=" 'insert-macron)
565 (define-key 8859-1-map ">" 'insert-angle-quotation-mark-right)
566 (define-key 8859-1-map "?" 'insert-inverted-question-mark)
567 (define-key 8859-1-map "A" 'insert-A-ring)
568 (define-key 8859-1-map "E" 'insert-AE)
569 (define-key 8859-1-map "C" 'insert-copyright-sign)
570 (define-key 8859-1-map "D" 'insert-D-stroke)
571 (define-key 8859-1-map "L" 'insert-pound-sign)
572 (define-key 8859-1-map "P" 'insert-pilcrow)
573 (define-key 8859-1-map "R" 'insert-registered-sign)
574 (define-key 8859-1-map "S" 'insert-section-sign)
575 (define-key 8859-1-map "T" 'insert-THORN)
576 (define-key 8859-1-map "Y" 'insert-yen-sign)
577 (define-key 8859-1-map "^" (make-sparse-keymap))
578 (define-key 8859-1-map "^1" 'insert-superscript-one)
579 (define-key 8859-1-map "^2" 'insert-superscript-two)
580 (define-key 8859-1-map "^3" 'insert-superscript-three)
581 (define-key 8859-1-map "^A" 'insert-A-circumflex)
582 (define-key 8859-1-map "^E" 'insert-E-circumflex)
583 (define-key 8859-1-map "^I" 'insert-I-circumflex)
584 (define-key 8859-1-map "^O" 'insert-O-circumflex)
585 (define-key 8859-1-map "^U" 'insert-U-circumflex)
586 (define-key 8859-1-map "^a" 'insert-a-circumflex)
587 (define-key 8859-1-map "^e" 'insert-e-circumflex)
588 (define-key 8859-1-map "^i" 'insert-i-circumflex)
589 (define-key 8859-1-map "^o" 'insert-o-circumflex)
590 (define-key 8859-1-map "^u" 'insert-u-circumflex)
591 (define-key 8859-1-map "_" (make-sparse-keymap))
592 (define-key 8859-1-map "_a" 'insert-ordinal-indicator-feminine)
593 (define-key 8859-1-map "_o" 'insert-ordinal-indicator-masculine)
594 (define-key 8859-1-map "`" (make-sparse-keymap))
595 (define-key 8859-1-map "`A" 'insert-A-grave)
596 (define-key 8859-1-map "`E" 'insert-E-grave)
597 (define-key 8859-1-map "`I" 'insert-I-grave)
598 (define-key 8859-1-map "`O" 'insert-O-grave)
599 (define-key 8859-1-map "`U" 'insert-U-grave)
600 (define-key 8859-1-map "`a" 'insert-a-grave)
601 (define-key 8859-1-map "`e" 'insert-e-grave)
602 (define-key 8859-1-map "`i" 'insert-i-grave)
603 (define-key 8859-1-map "`o" 'insert-o-grave)
604 (define-key 8859-1-map "`u" 'insert-u-grave)
605 (define-key 8859-1-map "a" 'insert-a-ring)
606 (define-key 8859-1-map "e" 'insert-ae)
607 (define-key 8859-1-map "c" 'insert-cent-sign)
608 (define-key 8859-1-map "d" 'insert-d-stroke)
609 (define-key 8859-1-map "o" 'insert-degree-sign)
610 (define-key 8859-1-map "s" 'insert-ss)
611 (define-key 8859-1-map "t" 'insert-thorn)
612 (define-key 8859-1-map "u" 'insert-micro-sign)
613 (define-key 8859-1-map "x" 'insert-multiplication-sign)
614 (define-key 8859-1-map "|" 'insert-broken-vertical-line)
615 (define-key 8859-1-map "~" (make-sparse-keymap))
616 (define-key 8859-1-map "~A" 'insert-A-tilde)
617 (define-key 8859-1-map "~N" 'insert-N-tilde)
618 (define-key 8859-1-map "~O" 'insert-O-tilde)
619 (define-key 8859-1-map "~a" 'insert-a-tilde)
620 (define-key 8859-1-map "~n" 'insert-n-tilde)
621 (define-key 8859-1-map "~o" 'insert-o-tilde)
622 (define-key 8859-1-map "~~" 'insert-not-sign)
623 (if (not (lookup-key global-map "\C-x8"))
624 (define-key global-map "\C-x8" 8859-1-map))
625)
626(defalias '8859-1-map 8859-1-map)
627
628(provide 'iso-insert)
629
630;;; iso-insert.el ends here
diff --git a/lisp/obsolete/iso-swed.el b/lisp/obsolete/iso-swed.el
deleted file mode 100644
index e3231be20e9..00000000000
--- a/lisp/obsolete/iso-swed.el
+++ /dev/null
@@ -1,150 +0,0 @@
1;;; iso-swed.el --- set up char tables for ISO 8859/1 for Swedish/Finnish ttys
2
3;; Copyright (C) 1987, 2001-2017 Free Software Foundation, Inc.
4
5;; Author: Howard Gayle
6;; Maintainer: emacs-devel@gnu.org
7;; Keywords: i18n
8;; Obsolete-since: 22.1
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software: you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24
25;;; Commentary:
26
27;; Written by Howard Gayle. See case-table.el for details.
28
29;;; Code:
30
31;; This code sets up to display ISO 8859/1 characters on
32;; terminals that have ASCII in the G0 set and a Swedish/Finnish
33;; version of ISO 646 in the G1 set. The G1 set differs from
34;; ASCII as follows:
35;;
36;; ASCII G1
37;; $ general currency sign
38;; @ capital E with acute accent
39;; [ capital A with diaeresis or umlaut mark
40;; \ capital O with diaeresis or umlaut mark
41;; ] capital A with ring
42;; ^ capital U with diaeresis or umlaut mark
43;; ` small e with acute accent
44;; { small a with diaeresis or umlaut mark
45;; | small o with diaeresis or umlaut mark
46;; } small a with ring
47;; ~ small u with diaeresis or umlaut mark
48
49(require 'disp-table)
50
51(standard-display-ascii 160 "{_}") ; NBSP (no-break space)
52(standard-display-ascii 161 "{!}") ; inverted exclamation mark
53(standard-display-ascii 162 "{c}") ; cent sign
54(standard-display-ascii 163 "{GBP}") ; pound sign
55(standard-display-g1 164 ?$) ; general currency sign
56(standard-display-ascii 165 "{JPY}") ; yen sign
57(standard-display-ascii 166 "{|}") ; broken vertical line
58(standard-display-ascii 167 "{S}") ; section sign
59(standard-display-ascii 168 "{\"}") ; diaeresis
60(standard-display-ascii 169 "{C}") ; copyright sign
61(standard-display-ascii 170 "{_a}") ; ordinal indicator, feminine
62(standard-display-ascii 171 "{<<}") ; left angle quotation mark
63(standard-display-ascii 172 "{~}") ; not sign
64(standard-display-ascii 173 "{-}") ; soft hyphen
65(standard-display-ascii 174 "{R}") ; registered sign
66(standard-display-ascii 175 "{=}") ; macron
67(standard-display-ascii 176 "{o}") ; degree sign
68(standard-display-ascii 177 "{+-}") ; plus or minus sign
69(standard-display-ascii 178 "{2}") ; superscript two
70(standard-display-ascii 179 "{3}") ; superscript three
71(standard-display-ascii 180 "{'}") ; acute accent
72(standard-display-ascii 181 "{u}") ; micro sign
73(standard-display-ascii 182 "{P}") ; pilcrow
74(standard-display-ascii 183 "{.}") ; middle dot
75(standard-display-ascii 184 "{,}") ; cedilla
76(standard-display-ascii 185 "{1}") ; superscript one
77(standard-display-ascii 186 "{_o}") ; ordinal indicator, masculine
78(standard-display-ascii 187 "{>>}") ; right angle quotation mark
79(standard-display-ascii 188 "{1/4}") ; fraction one-quarter
80(standard-display-ascii 189 "{1/2}") ; fraction one-half
81(standard-display-ascii 190 "{3/4}") ; fraction three-quarters
82(standard-display-ascii 191 "{?}") ; inverted question mark
83(standard-display-ascii 192 "{`A}") ; A with grave accent
84(standard-display-ascii 193 "{'A}") ; A with acute accent
85(standard-display-ascii 194 "{^A}") ; A with circumflex accent
86(standard-display-ascii 195 "{~A}") ; A with tilde
87(standard-display-g1 196 ?[) ; A with diaeresis or umlaut mark
88(standard-display-g1 197 ?]) ; A with ring
89(standard-display-ascii 198 "{AE}") ; AE diphthong
90(standard-display-ascii 199 "{,C}") ; C with cedilla
91(standard-display-ascii 200 "{`E}") ; E with grave accent
92(standard-display-g1 201 ?@) ; E with acute accent
93(standard-display-ascii 202 "{^E}") ; E with circumflex accent
94(standard-display-ascii 203 "{\"E}") ; E with diaeresis or umlaut mark
95(standard-display-ascii 204 "{`I}") ; I with grave accent
96(standard-display-ascii 205 "{'I}") ; I with acute accent
97(standard-display-ascii 206 "{^I}") ; I with circumflex accent
98(standard-display-ascii 207 "{\"I}") ; I with diaeresis or umlaut mark
99(standard-display-ascii 208 "{-D}") ; D with stroke, Icelandic eth
100(standard-display-ascii 209 "{~N}") ; N with tilde
101(standard-display-ascii 210 "{`O}") ; O with grave accent
102(standard-display-ascii 211 "{'O}") ; O with acute accent
103(standard-display-ascii 212 "{^O}") ; O with circumflex accent
104(standard-display-ascii 213 "{~O}") ; O with tilde
105(standard-display-g1 214 ?\\) ; O with diaeresis or umlaut mark
106(standard-display-ascii 215 "{x}") ; multiplication sign
107(standard-display-ascii 216 "{/O}") ; O with slash
108(standard-display-ascii 217 "{`U}") ; U with grave accent
109(standard-display-ascii 218 "{'U}") ; U with acute accent
110(standard-display-ascii 219 "{^U}") ; U with circumflex accent
111(standard-display-g1 220 ?^) ; U with diaeresis or umlaut mark
112(standard-display-ascii 221 "{'Y}") ; Y with acute accent
113(standard-display-ascii 222 "{TH}") ; capital thorn, Icelandic
114(standard-display-ascii 223 "{ss}") ; small sharp s, German
115(standard-display-ascii 224 "{`a}") ; a with grave accent
116(standard-display-ascii 225 "{'a}") ; a with acute accent
117(standard-display-ascii 226 "{^a}") ; a with circumflex accent
118(standard-display-ascii 227 "{~a}") ; a with tilde
119(standard-display-g1 228 ?{) ; a with diaeresis or umlaut mark
120(standard-display-g1 229 ?}) ; a with ring
121(standard-display-ascii 230 "{ae}") ; ae diphthong
122(standard-display-ascii 231 "{,c}") ; c with cedilla
123(standard-display-ascii 232 "{`e}") ; e with grave accent
124(standard-display-g1 233 ?`) ; e with acute accent
125(standard-display-ascii 234 "{^e}") ; e with circumflex accent
126(standard-display-ascii 235 "{\"e}") ; e with diaeresis or umlaut mark
127(standard-display-ascii 236 "{`i}") ; i with grave accent
128(standard-display-ascii 237 "{'i}") ; i with acute accent
129(standard-display-ascii 238 "{^i}") ; i with circumflex accent
130(standard-display-ascii 239 "{\"i}") ; i with diaeresis or umlaut mark
131(standard-display-ascii 240 "{-d}") ; d with stroke, Icelandic eth
132(standard-display-ascii 241 "{~n}") ; n with tilde
133(standard-display-ascii 242 "{`o}") ; o with grave accent
134(standard-display-ascii 243 "{'o}") ; o with acute accent
135(standard-display-ascii 244 "{^o}") ; o with circumflex accent
136(standard-display-ascii 245 "{~o}") ; o with tilde
137(standard-display-g1 246 ?|) ; o with diaeresis or umlaut mark
138(standard-display-ascii 247 "{/}") ; division sign
139(standard-display-ascii 248 "{/o}") ; o with slash
140(standard-display-ascii 249 "{`u}") ; u with grave accent
141(standard-display-ascii 250 "{'u}") ; u with acute accent
142(standard-display-ascii 251 "{^u}") ; u with circumflex accent
143(standard-display-g1 252 ?~) ; u with diaeresis or umlaut mark
144(standard-display-ascii 253 "{'y}") ; y with acute accent
145(standard-display-ascii 254 "{th}") ; small thorn, Icelandic
146(standard-display-ascii 255 "{\"y}") ; small y with diaeresis or umlaut mark
147
148(provide 'iso-swed)
149
150;;; iso-swed.el ends here
diff --git a/lisp/obsolete/resume.el b/lisp/obsolete/resume.el
deleted file mode 100644
index b4dfab29479..00000000000
--- a/lisp/obsolete/resume.el
+++ /dev/null
@@ -1,125 +0,0 @@
1;;; resume.el --- process command line args from within a suspended Emacs job
2
3;; Copyright (C) 1992, 2001-2017 Free Software Foundation, Inc.
4
5;; Author: Joe Wells <jbw@bucsf.bu.edu>
6;; Adapted-By: ESR
7;; Keywords: processes
8;; Obsolete-since: 23.1
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software: you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24
25;;; Commentary:
26
27;; The purpose of this library is to handle command line arguments
28;; when you resume an existing Emacs job.
29
30;; In order to use it, you must put this code in your .emacs file.
31
32;; (add-hook 'suspend-hook 'resume-suspend-hook)
33;; (add-hook 'suspend-resume-hook 'resume-process-args)
34
35;; You can't get the benefit of this library by using the `emacs' command,
36;; since that always starts a new Emacs job. Instead you must use a
37;; command called `edit' which knows how to resume an existing Emacs job
38;; if you have one, or start a new Emacs job if you don't have one.
39
40;; To define the `edit' command, run the script etc/emacs.csh (if you use CSH),
41;; or etc/emacs.bash if you use BASH. You would normally do this in your
42;; login script.
43
44;; Stephan Gildea suggested bug fix (gildea@bbn.com).
45;; Ideas from Michael DeCorte and other people.
46
47;;; Code:
48
49(defvar resume-emacs-args-file (expand-file-name "~/.emacs_args")
50 "This file is where arguments are placed for a suspended Emacs job.")
51
52(defvar resume-emacs-args-buffer " *Command Line Args*"
53 "Buffer that is used by `resume-process-args'.")
54
55(defun resume-process-args ()
56 "Handler for command line args given when Emacs is resumed."
57 (let ((start-buffer (current-buffer))
58 (args-buffer (get-buffer-create resume-emacs-args-buffer))
59 length args
60 (command-line-default-directory default-directory))
61 (unwind-protect
62 (progn
63 (set-buffer args-buffer)
64 (erase-buffer)
65 ;; get the contents of resume-emacs-args-file
66 (condition-case ()
67 (let ((result (insert-file-contents resume-emacs-args-file)))
68 (setq length (car (cdr result))))
69 ;; the file doesn't exist, ergo no arguments
70 (file-error
71 (erase-buffer)
72 (setq length 0)))
73 (if (<= length 0)
74 (setq args nil)
75 ;; get the arguments from the buffer
76 (goto-char (point-min))
77 (while (not (eobp))
78 (skip-chars-forward " \t\n")
79 (let ((begin (point)))
80 (skip-chars-forward "^ \t\n")
81 (setq args (cons (buffer-substring begin (point)) args)))
82 (skip-chars-forward " \t\n"))
83 ;; arguments are now in reverse order
84 (setq args (nreverse args))
85 ;; make sure they're not read again
86 (erase-buffer))
87 (resume-write-buffer-to-file (current-buffer) resume-emacs-args-file)
88 ;; if nothing was in buffer, args will be null
89 (or (null args)
90 (setq command-line-default-directory
91 (file-name-as-directory (car args))
92 args (cdr args)))
93 ;; actually process the arguments
94 (command-line-1 args))
95 ;; If the command line args don't result in a find-file, the
96 ;; buffer will be left in args-buffer. So we change back to the
97 ;; original buffer. The reason I don't just use
98 ;; (let ((default-directory foo))
99 ;; (command-line-1 args))
100 ;; in the context of the original buffer is because let does not
101 ;; work properly with buffer-local variables.
102 (if (eq (current-buffer) args-buffer)
103 (set-buffer start-buffer)))))
104
105;;;###autoload
106(defun resume-suspend-hook ()
107 "Clear out the file used for transmitting args when Emacs resumes."
108 (with-current-buffer (get-buffer-create resume-emacs-args-buffer)
109 (erase-buffer)
110 (resume-write-buffer-to-file (current-buffer) resume-emacs-args-file)))
111
112(defun resume-write-buffer-to-file (buffer file)
113 "Writes the contents of BUFFER into FILE, if permissions allow."
114 (if (not (file-writable-p file))
115 (error "No permission to write file %s" file))
116 (with-current-buffer buffer
117 (clear-visited-file-modtime)
118 (save-restriction
119 (widen)
120 (write-region (point-min) (point-max) file nil 'quiet))
121 (set-buffer-modified-p nil)))
122
123(provide 'resume)
124
125;;; resume.el ends here
diff --git a/lisp/obsolete/scribe.el b/lisp/obsolete/scribe.el
deleted file mode 100644
index f9ec9c953c0..00000000000
--- a/lisp/obsolete/scribe.el
+++ /dev/null
@@ -1,329 +0,0 @@
1;;; scribe.el --- scribe mode, and its idiosyncratic commands
2
3;; Copyright (C) 1985, 2001-2017 Free Software Foundation, Inc.
4
5;; Author: William Sommerfeld
6;; (according to ack.texi)
7;; Maintainer: emacs-devel@gnu.org
8;; Keywords: wp
9;; Obsolete-since: 22.1
10
11;; This file is part of GNU Emacs.
12
13;; GNU Emacs is free software: you can redistribute it and/or modify
14;; it under the terms of the GNU General Public License as published by
15;; the Free Software Foundation, either version 3 of the License, or
16;; (at your option) any later version.
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
24;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25
26;;; Commentary:
27
28;; A major mode for editing source in written for the Scribe text formatter.
29;; Knows about Scribe syntax and standard layout rules. The command to
30;; run Scribe on a buffer is bogus; someone interested should fix it.
31
32;;; Code:
33
34(defvar compile-command)
35
36(defgroup scribe nil
37 "Scribe mode."
38 :prefix "scribe-"
39 :group 'wp)
40
41(defvar scribe-mode-syntax-table nil
42 "Syntax table used while in scribe mode.")
43
44(defvar scribe-mode-abbrev-table nil
45 "Abbrev table used while in scribe mode.")
46
47(defcustom scribe-fancy-paragraphs nil
48 "Non-nil makes Scribe mode use a different style of paragraph separation."
49 :type 'boolean
50 :group 'scribe)
51
52(defcustom scribe-electric-quote nil
53 "Non-nil makes insert of double quote use \\=`\\=` or \\='\\=' depending on context."
54 :type 'boolean
55 :group 'scribe)
56
57(defcustom scribe-electric-parenthesis nil
58 "Non-nil makes parenthesis char ( (]}> ) automatically insert its close
59if typed after an @Command form."
60 :type 'boolean
61 :group 'scribe)
62
63(defconst scribe-open-parentheses "[({<"
64 "Open parenthesis characters for Scribe.")
65
66(defconst scribe-close-parentheses "])}>"
67 "Close parenthesis characters for Scribe.
68These should match up with `scribe-open-parenthesis'.")
69
70(if (null scribe-mode-syntax-table)
71 (let ((st (syntax-table)))
72 (unwind-protect
73 (progn
74 (setq scribe-mode-syntax-table (copy-syntax-table
75 text-mode-syntax-table))
76 (set-syntax-table scribe-mode-syntax-table)
77 (modify-syntax-entry ?\" " ")
78 (modify-syntax-entry ?\\ " ")
79 (modify-syntax-entry ?@ "w ")
80 (modify-syntax-entry ?< "(> ")
81 (modify-syntax-entry ?> ")< ")
82 (modify-syntax-entry ?[ "(] ")
83 (modify-syntax-entry ?] ")[ ")
84 (modify-syntax-entry ?{ "(} ")
85 (modify-syntax-entry ?} "){ ")
86 (modify-syntax-entry ?' "w "))
87 (set-syntax-table st))))
88
89(defvar scribe-mode-map nil)
90
91(if scribe-mode-map
92 nil
93 (setq scribe-mode-map (make-sparse-keymap))
94 (define-key scribe-mode-map "\t" 'scribe-tab)
95 (define-key scribe-mode-map "\e\t" 'tab-to-tab-stop)
96 (define-key scribe-mode-map "\es" 'center-line)
97 (define-key scribe-mode-map "\e}" 'up-list)
98 (define-key scribe-mode-map "\eS" 'center-paragraph)
99 (define-key scribe-mode-map "\"" 'scribe-insert-quote)
100 (define-key scribe-mode-map "(" 'scribe-parenthesis)
101 (define-key scribe-mode-map "[" 'scribe-parenthesis)
102 (define-key scribe-mode-map "{" 'scribe-parenthesis)
103 (define-key scribe-mode-map "<" 'scribe-parenthesis)
104 (define-key scribe-mode-map "\C-c\C-c" 'scribe-chapter)
105 (define-key scribe-mode-map "\C-c\C-t" 'scribe-section)
106 (define-key scribe-mode-map "\C-c\C-s" 'scribe-subsection)
107 (define-key scribe-mode-map "\C-c\C-v" 'scribe-insert-environment)
108 (define-key scribe-mode-map "\C-c\C-e" 'scribe-bracket-region-be)
109 (define-key scribe-mode-map "\C-c[" 'scribe-begin)
110 (define-key scribe-mode-map "\C-c]" 'scribe-end)
111 (define-key scribe-mode-map "\C-c\C-i" 'scribe-italicize-word)
112 (define-key scribe-mode-map "\C-c\C-b" 'scribe-bold-word)
113 (define-key scribe-mode-map "\C-c\C-u" 'scribe-underline-word))
114
115;;;###autoload
116(define-derived-mode scribe-mode text-mode "Scribe"
117 "Major mode for editing files of Scribe (a text formatter) source.
118Scribe-mode is similar to text-mode, with a few extra commands added.
119\\{scribe-mode-map}
120
121Interesting variables:
122
123`scribe-fancy-paragraphs'
124 Non-nil makes Scribe mode use a different style of paragraph separation.
125
126`scribe-electric-quote'
127 Non-nil makes insert of double quote use \\=`\\=` or \\='\\=' depending on context.
128
129`scribe-electric-parenthesis'
130 Non-nil makes an open-parenthesis char (one of `([<{')
131 automatically insert its close if typed after an @Command form."
132 (set (make-local-variable 'comment-start) "@Comment[")
133 (set (make-local-variable 'comment-start-skip) (concat "@Comment[" scribe-open-parentheses "]"))
134 (set (make-local-variable 'comment-column) 0)
135 (set (make-local-variable 'comment-end) "]")
136 (set (make-local-variable 'paragraph-start)
137 (concat "\\([\n\f]\\)\\|\\(@\\w+["
138 scribe-open-parentheses
139 "].*["
140 scribe-close-parentheses
141 "]$\\)"))
142 (set (make-local-variable 'paragraph-separate)
143 (if scribe-fancy-paragraphs paragraph-start "$"))
144 (set (make-local-variable 'sentence-end)
145 "\\([.?!]\\|@:\\)[]\"')}]*\\($\\| $\\|\t\\| \\)[ \t\n]*")
146 (set (make-local-variable 'compile-command)
147 (concat "scribe "
148 (if buffer-file-name
149 (shell-quote-argument (buffer-file-name))))))
150
151(defun scribe-tab ()
152 (interactive)
153 (insert "@\\"))
154
155;; This algorithm could probably be improved somewhat.
156;; Right now, it loses seriously...
157
158(defun scribe ()
159 "Run Scribe on the current buffer."
160 (interactive)
161 (call-interactively 'compile))
162
163(defun scribe-envelop-word (string count)
164 "Surround current word with Scribe construct @STRING[...].
165COUNT specifies how many words to surround. A negative count means
166to skip backward."
167 (let ((spos (point)) (epos (point)) (ccoun 0) noparens)
168 (if (not (zerop count))
169 (progn (if (= (char-syntax (preceding-char)) ?w)
170 (forward-sexp (min -1 count)))
171 (setq spos (point))
172 (if (looking-at (concat "@\\w[" scribe-open-parentheses "]"))
173 (forward-char 2)
174 (goto-char epos)
175 (skip-chars-backward "\\W")
176 (forward-char -1))
177 (forward-sexp (max count 1))
178 (setq epos (point))))
179 (goto-char spos)
180 (while (and (< ccoun (length scribe-open-parentheses))
181 (save-excursion
182 (or (search-forward (char-to-string
183 (aref scribe-open-parentheses ccoun))
184 epos t)
185 (search-forward (char-to-string
186 (aref scribe-close-parentheses ccoun))
187 epos t)))
188 (setq ccoun (1+ ccoun))))
189 (if (>= ccoun (length scribe-open-parentheses))
190 (progn (goto-char epos)
191 (insert "@end(" string ")")
192 (goto-char spos)
193 (insert "@begin(" string ")"))
194 (goto-char epos)
195 (insert (aref scribe-close-parentheses ccoun))
196 (goto-char spos)
197 (insert "@" string (aref scribe-open-parentheses ccoun))
198 (goto-char epos)
199 (forward-char 3)
200 (skip-chars-forward scribe-close-parentheses))))
201
202(defun scribe-underline-word (count)
203 "Underline COUNT words around point by means of Scribe constructs."
204 (interactive "p")
205 (scribe-envelop-word "u" count))
206
207(defun scribe-bold-word (count)
208 "Boldface COUNT words around point by means of Scribe constructs."
209 (interactive "p")
210 (scribe-envelop-word "b" count))
211
212(defun scribe-italicize-word (count)
213 "Italicize COUNT words around point by means of Scribe constructs."
214 (interactive "p")
215 (scribe-envelop-word "i" count))
216
217(defun scribe-begin ()
218 (interactive)
219 (insert "\n")
220 (forward-char -1)
221 (scribe-envelop-word "Begin" 0)
222 (re-search-forward (concat "[" scribe-open-parentheses "]")))
223
224(defun scribe-end ()
225 (interactive)
226 (insert "\n")
227 (forward-char -1)
228 (scribe-envelop-word "End" 0)
229 (re-search-forward (concat "[" scribe-open-parentheses "]")))
230
231(defun scribe-chapter ()
232 (interactive)
233 (insert "\n")
234 (forward-char -1)
235 (scribe-envelop-word "Chapter" 0)
236 (re-search-forward (concat "[" scribe-open-parentheses "]")))
237
238(defun scribe-section ()
239 (interactive)
240 (insert "\n")
241 (forward-char -1)
242 (scribe-envelop-word "Section" 0)
243 (re-search-forward (concat "[" scribe-open-parentheses "]")))
244
245(defun scribe-subsection ()
246 (interactive)
247 (insert "\n")
248 (forward-char -1)
249 (scribe-envelop-word "SubSection" 0)
250 (re-search-forward (concat "[" scribe-open-parentheses "]")))
251
252(defun scribe-bracket-region-be (env min max)
253 (interactive "sEnvironment: \nr")
254 (save-excursion
255 (goto-char max)
256 (insert "@end(" env ")\n")
257 (goto-char min)
258 (insert "@begin(" env ")\n")))
259
260(defun scribe-insert-environment (env)
261 (interactive "sEnvironment: ")
262 (scribe-bracket-region-be env (point) (point))
263 (forward-line 1)
264 (insert ?\n)
265 (forward-char -1))
266
267(defun scribe-insert-quote (count)
268 "Insert \\=`\\=`, \\='\\=' or \" according to preceding character.
269If `scribe-electric-quote' is non-nil, insert \\=`\\=`, \\='\\=' or \" according
270to preceding character. With numeric arg N, always insert N \" characters.
271Else just insert \"."
272 (interactive "P")
273 (if (or count (not scribe-electric-quote))
274 (self-insert-command (prefix-numeric-value count))
275 (let (lastfore lastback lastquote)
276 (insert
277 (cond
278 ((= (preceding-char) ?\\) ?\")
279 ((bobp) "``")
280 (t
281 (setq lastfore (save-excursion (and (search-backward
282 "``" (- (point) 1000) t)
283 (point)))
284 lastback (save-excursion (and (search-backward
285 "''" (- (point) 1000) t)
286 (point)))
287 lastquote (save-excursion (and (search-backward
288 "\"" (- (point) 100) t)
289 (point))))
290 (if (not lastquote)
291 (cond ((not lastfore) "``")
292 ((not lastback) "''")
293 ((> lastfore lastback) "''")
294 (t "``"))
295 (cond ((and (not lastback) (not lastfore)) "\"")
296 ((and lastback (not lastfore) (> lastquote lastback)) "\"")
297 ((and lastback (not lastfore) (> lastback lastquote)) "``")
298 ((and lastfore (not lastback) (> lastquote lastfore)) "\"")
299 ((and lastfore (not lastback) (> lastfore lastquote)) "''")
300 ((and (> lastquote lastfore) (> lastquote lastback)) "\"")
301 ((> lastfore lastback) "''")
302 (t "``")))))))))
303
304(defun scribe-parenthesis (count)
305 "If scribe-electric-parenthesis is non-nil, insertion of an open-parenthesis
306character inserts the following close parenthesis character if the
307preceding text is of the form @Command."
308 (interactive "P")
309 (self-insert-command (prefix-numeric-value count))
310 (let (at-command paren-char point-save)
311 (if (or count (not scribe-electric-parenthesis))
312 nil
313 (save-excursion
314 (forward-char -1)
315 (setq point-save (point))
316 (skip-chars-backward (concat "^ \n\t\f" scribe-open-parentheses))
317 (setq at-command (and (equal (following-char) ?@)
318 (/= (point) (1- point-save)))))
319 (if (and at-command
320 (setq paren-char
321 (string-match (regexp-quote
322 (char-to-string (preceding-char)))
323 scribe-open-parentheses)))
324 (save-excursion
325 (insert (aref scribe-close-parentheses paren-char)))))))
326
327(provide 'scribe)
328
329;;; scribe.el ends here
diff --git a/lisp/obsolete/spell.el b/lisp/obsolete/spell.el
deleted file mode 100644
index 5f8ad13b515..00000000000
--- a/lisp/obsolete/spell.el
+++ /dev/null
@@ -1,171 +0,0 @@
1;;; spell.el --- spelling correction interface for Emacs
2
3;; Copyright (C) 1985, 2001-2017 Free Software Foundation, Inc.
4
5;; Maintainer: emacs-devel@gnu.org
6;; Keywords: wp, unix
7;; Obsolete-since: 23.1
8;; (not in obsolete/ directory then, but all functions marked obsolete)
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software: you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24
25;;; Commentary:
26
27;; This mode provides an Emacs interface to the UNIX spell(1) program.
28;; Entry points are `spell-buffer', `spell-word', `spell-region' and
29;; `spell-string'.
30
31;; See also ispell.el for an interface to the ispell program.
32
33;;; Code:
34
35(defgroup spell nil
36 "Interface to the UNIX spell(1) program."
37 :prefix "spell-"
38 :group 'applications)
39
40(defcustom spell-command "spell"
41 "Command to run the spell program."
42 :type 'string
43 :group 'spell)
44
45(defcustom spell-filter nil
46 "Filter function to process text before passing it to spell program.
47This function might remove text-processor commands.
48nil means don't alter the text before checking it."
49 :type '(choice (const nil) function)
50 :group 'spell)
51
52;;;###autoload
53(put 'spell-filter 'risky-local-variable t)
54
55;;;###autoload
56(defun spell-buffer ()
57 "Check spelling of every word in the buffer.
58For each incorrect word, you are asked for the correct spelling
59and then put into a query-replace to fix some or all occurrences.
60If you do not want to change a word, just give the same word
61as its \"correct\" spelling; then the query replace is skipped."
62 (interactive)
63 ;; Don't warn about spell-region being obsolete.
64 (with-no-warnings
65 (spell-region (point-min) (point-max) "buffer")))
66;;;###autoload
67(make-obsolete 'spell-buffer 'ispell-buffer "23.1")
68
69;;;###autoload
70(defun spell-word ()
71 "Check spelling of word at or before point.
72If it is not correct, ask user for the correct spelling
73and `query-replace' the entire buffer to substitute it."
74 (interactive)
75 (let (beg end spell-filter)
76 (save-excursion
77 (if (not (looking-at "\\<"))
78 (forward-word -1))
79 (setq beg (point))
80 (forward-word 1)
81 (setq end (point)))
82 ;; Don't warn about spell-region being obsolete.
83 (with-no-warnings
84 (spell-region beg end (buffer-substring beg end)))))
85;;;###autoload
86(make-obsolete 'spell-word 'ispell-word "23.1")
87
88;;;###autoload
89(defun spell-region (start end &optional description)
90 "Like `spell-buffer' but applies only to region.
91Used in a program, applies from START to END.
92DESCRIPTION is an optional string naming the unit being checked:
93for example, \"word\"."
94 (interactive "r")
95 (let ((filter spell-filter)
96 (buf (get-buffer-create " *temp*")))
97 (with-current-buffer buf
98 (widen)
99 (erase-buffer))
100 (message "Checking spelling of %s..." (or description "region"))
101 (if (and (null filter) (= ?\n (char-after (1- end))))
102 (if (string= "spell" spell-command)
103 (call-process-region start end "spell" nil buf)
104 (call-process-region start end shell-file-name
105 nil buf nil "-c" spell-command))
106 (let ((oldbuf (current-buffer)))
107 (with-current-buffer buf
108 (insert-buffer-substring oldbuf start end)
109 (or (bolp) (insert ?\n))
110 (if filter (funcall filter))
111 (if (string= "spell" spell-command)
112 (call-process-region (point-min) (point-max) "spell" t buf)
113 (call-process-region (point-min) (point-max) shell-file-name
114 t buf nil "-c" spell-command)))))
115 (message "Checking spelling of %s...%s"
116 (or description "region")
117 (if (with-current-buffer buf
118 (> (buffer-size) 0))
119 "not correct"
120 "correct"))
121 (let (word newword
122 (case-fold-search t)
123 (case-replace t))
124 (while (with-current-buffer buf
125 (> (buffer-size) 0))
126 (with-current-buffer buf
127 (goto-char (point-min))
128 (setq word (downcase
129 (buffer-substring (point)
130 (progn (end-of-line) (point)))))
131 (forward-char 1)
132 (delete-region (point-min) (point))
133 (setq newword
134 (read-string (concat "`" word
135 "' not recognized; edit a replacement: ")
136 word))
137 (flush-lines (concat "^" (regexp-quote word) "$")))
138 (if (not (equal word newword))
139 (progn
140 (goto-char (point-min))
141 (query-replace-regexp (concat "\\b" (regexp-quote word) "\\b")
142 newword)))))))
143;;;###autoload
144(make-obsolete 'spell-region 'ispell-region "23.1")
145
146;;;###autoload
147(defun spell-string (string)
148 "Check spelling of string supplied as argument."
149 (interactive "sSpell string: ")
150 (with-temp-buffer
151 (widen)
152 (erase-buffer)
153 (insert string "\n")
154 (if (string= "spell" spell-command)
155 (call-process-region (point-min) (point-max) "spell"
156 t t)
157 (call-process-region (point-min) (point-max) shell-file-name
158 t t nil "-c" spell-command))
159 (if (= 0 (buffer-size))
160 (message "%s is correct" string)
161 (goto-char (point-min))
162 (while (search-forward "\n" nil t)
163 (replace-match " "))
164 (message "%sincorrect" (buffer-substring 1 (point-max))))))
165;;;###autoload
166(make-obsolete 'spell-string "The `spell' package is obsolete - use `ispell'."
167 "23.1")
168
169(provide 'spell)
170
171;;; spell.el ends here
diff --git a/lisp/obsolete/swedish.el b/lisp/obsolete/swedish.el
deleted file mode 100644
index 2254441071c..00000000000
--- a/lisp/obsolete/swedish.el
+++ /dev/null
@@ -1,160 +0,0 @@
1;;; swedish.el --- miscellaneous functions for dealing with Swedish
2
3;; Copyright (C) 1988, 2001-2017 Free Software Foundation, Inc.
4
5;; Author: Howard Gayle
6;; Maintainer: emacs-devel@gnu.org
7;; Keywords: i18n
8;; Obsolete-since: 22.1
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software: you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24
25;;; Commentary:
26
27;; Fixme: Is this actually used? if so, it should be in language,
28;; possibly as a feature property of Swedish, probably defining a
29;; `swascii' coding system.
30
31;;; Code:
32
33;; Written by Howard Gayle. See case-table.el for details.
34
35;; See iso-swed.el for a description of the character set.
36
37(defvar mail-send-hook)
38(defvar news-group-hook-alist)
39(defvar news-inews-hook)
40
41(defvar swedish-re
42 "[ \t\n]\\(och\\|att\\|en\\|{r\\|\\[R\\|p}\\|P\\]\\|som\\|det\\|av\\|den\\|f|r\\|F\\\\R\\)[ \t\n.,?!:;'\")}]"
43 "Regular expression for common Swedish words.")
44
45(defvar swascii-to-8859-trans
46 (let ((string (make-string 256 ? ))
47 (i 0))
48 (while (< i 256)
49 (aset string i i)
50 (setq i (1+ i)))
51 (aset string ?\[ 196)
52 (aset string ?\] 197)
53 (aset string ?\\ 214)
54 (aset string ?^ 220)
55 (aset string ?\{ 228)
56 (aset string ?\} 229)
57 (aset string ?\` 233)
58 (aset string ?\| 246)
59 (aset string ?~ 252)
60 string)
61 "Trans table from SWASCII to 8859.")
62
63; $ is not converted because it almost always means US
64; dollars, not general currency sign. @ is not converted
65; because it is more likely to be an at sign in a mail address
66; than an E with acute accent.
67
68(defun swascii-to-8859-buffer ()
69 "Convert characters in buffer from Swedish/Finnish-ascii to ISO 8859/1.
70Works even on read-only buffers. `$' and `@' are not converted."
71 (interactive)
72 (let ((buffer-read-only nil))
73 (translate-region (point-min) (point-max) swascii-to-8859-trans)))
74
75(defun swascii-to-8859-buffer-maybe ()
76 "Call swascii-to-8859-buffer if the buffer looks like Swedish-ascii.
77Leaves point just after the word that looks Swedish."
78 (interactive)
79 (let ((case-fold-search t))
80 (if (re-search-forward swedish-re nil t)
81 (swascii-to-8859-buffer))))
82
83(setq rmail-show-message-hook 'swascii-to-8859-buffer-maybe)
84
85(setq news-group-hook-alist
86 (append '(("^swnet." . swascii-to-8859-buffer-maybe))
87 (bound-and-true-p news-group-hook-alist)))
88
89(defvar 8859-to-swascii-trans
90 (let ((string (make-string 256 ? ))
91 (i 0))
92 (while (< i 256)
93 (aset string i i)
94 (setq i (1+ i)))
95 (aset string 164 ?$)
96 (aset string 196 ?\[)
97 (aset string 197 ?\])
98 (aset string 201 ?@)
99 (aset string 214 ?\\)
100 (aset string 220 ?^)
101 (aset string 228 ?\{)
102 (aset string 229 ?\})
103 (aset string 233 ?\`)
104 (aset string 246 ?\|)
105 (aset string 252 ?~)
106 string)
107 "8859 to SWASCII trans table.")
108
109(defun 8859-to-swascii-buffer ()
110 "Convert characters in buffer from ISO 8859/1 to Swedish/Finnish-ascii."
111 (interactive "*")
112 (translate-region (point-min) (point-max) 8859-to-swascii-trans))
113
114(setq mail-send-hook '8859-to-swascii-buffer)
115(setq news-inews-hook '8859-to-swascii-buffer)
116
117;; It's not clear what purpose is served by a separate
118;; Swedish mode that differs from Text mode only in having
119;; a separate abbrev table. Nothing says that the abbrevs you
120;; define in Text mode have to be English!
121
122;(defvar swedish-mode-abbrev-table nil
123; "Abbrev table used while in swedish mode.")
124;(define-abbrev-table 'swedish-mode-abbrev-table ())
125
126;(defun swedish-mode ()
127; "Major mode for editing Swedish text intended for humans to
128;read. Special commands:\\{text-mode-map}
129;Turning on swedish-mode calls the value of the variable
130;text-mode-hook, if that value is non-nil."
131; (interactive)
132; (kill-all-local-variables)
133; (use-local-map text-mode-map)
134; (setq mode-name "Swedish")
135; (setq major-mode 'swedish-mode)
136; (setq local-abbrev-table swedish-mode-abbrev-table)
137; (set-syntax-table text-mode-syntax-table)
138; (run-mode-hooks 'text-mode-hook))
139
140;(defun indented-swedish-mode ()
141; "Major mode for editing indented Swedish text intended for
142;humans to read.\\{indented-text-mode-map}
143;Turning on indented-swedish-mode calls the value of the
144;variable text-mode-hook, if that value is non-nil."
145; (interactive)
146; (kill-all-local-variables)
147; (use-local-map text-mode-map)
148; (define-abbrev-table 'swedish-mode-abbrev-table ())
149; (setq local-abbrev-table swedish-mode-abbrev-table)
150; (set-syntax-table text-mode-syntax-table)
151; (make-local-variable 'indent-line-function)
152; (setq indent-line-function 'indent-relative-maybe)
153; (use-local-map indented-text-mode-map)
154; (setq mode-name "Indented Swedish")
155; (setq major-mode 'indented-swedish-mode)
156; (run-mode-hooks 'text-mode-hook))
157
158(provide 'swedish)
159
160;;; swedish.el ends here
diff --git a/lisp/obsolete/sym-comp.el b/lisp/obsolete/sym-comp.el
deleted file mode 100644
index 4418450fe4a..00000000000
--- a/lisp/obsolete/sym-comp.el
+++ /dev/null
@@ -1,237 +0,0 @@
1;;; sym-comp.el --- mode-dependent symbol completion
2
3;; Copyright (C) 2004, 2008-2017 Free Software Foundation, Inc.
4
5;; Author: Dave Love <fx@gnu.org>
6;; Keywords: extensions
7;; URL: http://www.loveshack.ukfsn.org/emacs
8;; Obsolete-since: 23.2
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software: you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24
25;;; Commentary:
26
27;; This defines `symbol-complete', which is a generalization of the
28;; old `lisp-complete-symbol'. It provides the following hooks to
29;; allow major modes to set up completion appropriate for the mode:
30;; `symbol-completion-symbol-function',
31;; `symbol-completion-completions-function',
32;; `symbol-completion-predicate-function',
33;; `symbol-completion-transform-function'. Typically it is only
34;; necessary for a mode to set
35;; `symbol-completion-completions-function' locally and to bind
36;; `symbol-complete' appropriately.
37
38;; It's unfortunate that there doesn't seem to be a good way of
39;; combining this with `complete-symbol'.
40
41;; There is also `symbol-completion-try-complete', for use with
42;; Hippie-exp.
43
44;;; Code:
45
46;;;; Mode-dependent symbol completion.
47
48(defun symbol-completion-symbol ()
49 "Default `symbol-completion-symbol-function'.
50Uses `current-word' with the buffer narrowed to the part before
51point."
52 (save-restriction
53 ;; Narrow in case point is in the middle of a symbol -- we want
54 ;; just the preceding part.
55 (narrow-to-region (point-min) (point))
56 (current-word)))
57
58(defvar symbol-completion-symbol-function 'symbol-completion-symbol
59 "Function to return a partial symbol before point for completion.
60The value it returns should be a string (or nil).
61Major modes may set this locally if the default isn't appropriate.
62
63Beware: the length of the string STR returned need to be equal to the length
64of text before point that's subject to completion. Typically, this amounts
65to saying that STR is equal to
66\(buffer-substring (- (point) (length STR)) (point)).")
67
68(defvar symbol-completion-completions-function nil
69 "Function to return possible symbol completions.
70It takes an argument which is the string to be completed and
71returns a value suitable for the second argument of
72`try-completion'. This value need not use the argument, i.e. it
73may be all possible completions, such as `obarray' in the case of
74Emacs Lisp.
75
76Major modes may set this locally to allow them to support
77`symbol-complete'. See also `symbol-completion-symbol-function',
78`symbol-completion-predicate-function' and
79`symbol-completion-transform-function'.")
80
81(defvar symbol-completion-predicate-function nil
82 "If non-nil, function to return a predicate for selecting symbol completions.
83The function gets two args, the positions of the beginning and
84end of the symbol to be completed.
85
86Major modes may set this locally if the default isn't
87appropriate. This is a function returning a predicate so that
88the predicate can be context-dependent, e.g. to select only
89function names if point is at a function call position. The
90function's args may be useful for determining the context.")
91
92(defvar symbol-completion-transform-function nil
93 "If non-nil, function to transform symbols in the symbol-completion buffer.
94E.g., for Lisp, it may annotate the symbol as being a function,
95not a variable.
96
97The function takes the symbol name as argument. If it needs to
98annotate this, it should return a value suitable as an element of
99the list passed to `display-completion-list'.
100
101The predicate being used for selecting completions (from
102`symbol-completion-predicate-function') is available
103dynamically-bound as `symbol-completion-predicate' in case the
104transform needs it.")
105
106(defvar symbol-completion-predicate)
107
108;;;###autoload
109(defun symbol-complete (&optional predicate)
110 "Perform completion of the symbol preceding point.
111This is done in a way appropriate to the current major mode,
112perhaps by interrogating an inferior interpreter. Compare
113`complete-symbol'.
114If no characters can be completed, display a list of possible completions.
115Repeating the command at that point scrolls the list.
116
117When called from a program, optional arg PREDICATE is a predicate
118determining which symbols are considered.
119
120This function requires `symbol-completion-completions-function'
121to be set buffer-locally. Variables `symbol-completion-symbol-function',
122`symbol-completion-predicate-function' and
123`symbol-completion-transform-function' are also consulted."
124 (interactive)
125 ;; Fixme: Punt to `complete-symbol' in this case?
126 (unless (functionp symbol-completion-completions-function)
127 (error "symbol-completion-completions-function not defined"))
128 (let* ((pattern (or (funcall symbol-completion-symbol-function)
129 (error "No preceding symbol to complete")))
130 ;; FIXME: We assume below that `pattern' holds the text just
131 ;; before point. This is a problem in the way
132 ;; symbol-completion-symbol-function was defined.
133 (predicate (or predicate
134 (if symbol-completion-predicate-function
135 (funcall symbol-completion-predicate-function
136 (- (point) (length pattern))
137 (point)))))
138 (completions (funcall symbol-completion-completions-function
139 pattern))
140 ;; In case the transform needs to access it.
141 (symbol-completion-predicate predicate)
142 (completion-extra-properties
143 (if (functionp symbol-completion-transform-function)
144 '(:annotation-function
145 (lambda (str)
146 (car-safe (cdr-safe
147 (funcall symbol-completion-transform-function
148 str))))))))
149 (completion-in-region (- (point) (length pattern)) (point)
150 completions predicate)))
151
152(defvar he-search-string)
153(defvar he-tried-table)
154(defvar he-expand-list)
155(declare-function he-init-string "hippie-exp" (beg end))
156(declare-function he-string-member "hippie-exp" (str lst &optional trans-case))
157(declare-function he-substitute-string "hippie-exp" (str &optional trans-case))
158(declare-function he-reset-string "hippie-exp" ())
159
160;;;###autoload
161(defun symbol-completion-try-complete (old)
162 "Completion function for use with `hippie-expand'.
163Uses `symbol-completion-symbol-function' and
164`symbol-completion-completions-function'. It is intended to be
165used something like this in a major mode which provides symbol
166completion:
167
168 (if (featurep \\='hippie-exp)
169 (set (make-local-variable \\='hippie-expand-try-functions-list)
170 (cons \\='symbol-completion-try-complete
171 hippie-expand-try-functions-list)))"
172 (when (and symbol-completion-symbol-function
173 symbol-completion-completions-function)
174 (unless old
175 (let ((symbol (funcall symbol-completion-symbol-function)))
176 (he-init-string (- (point) (length symbol)) (point))
177 (if (not (he-string-member he-search-string he-tried-table))
178 (push he-search-string he-tried-table))
179 (setq he-expand-list
180 (and symbol
181 (funcall symbol-completion-completions-function symbol)))))
182 (while (and he-expand-list
183 (he-string-member (car he-expand-list) he-tried-table))
184 (pop he-expand-list))
185 (if he-expand-list
186 (progn
187 (he-substitute-string (pop he-expand-list))
188 t)
189 (if old (he-reset-string))
190 nil)))
191
192;;; Emacs Lisp symbol completion.
193
194(defun lisp-completion-symbol ()
195 "`symbol-completion-symbol-function' for Lisp."
196 (let ((end (point))
197 (beg (with-syntax-table emacs-lisp-mode-syntax-table
198 (save-excursion
199 (backward-sexp 1)
200 (while (= (char-syntax (following-char)) ?\')
201 (forward-char 1))
202 (point)))))
203 (buffer-substring-no-properties beg end)))
204
205(defun lisp-completion-predicate (beg end)
206 "`symbol-completion-predicate-function' for Lisp."
207 (save-excursion
208 (goto-char beg)
209 (if (not (eq (char-before) ?\())
210 (lambda (sym) ;why not just nil ? -sm
211 ;To avoid interned symbols with
212 ;no slots. -- fx
213 (or (boundp sym) (fboundp sym)
214 (symbol-plist sym)))
215 ;; Looks like a funcall position. Let's double check.
216 (if (condition-case nil
217 (progn (up-list -2) (forward-char 1)
218 (eq (char-after) ?\())
219 (error nil))
220 ;; If the first element of the parent list is an open
221 ;; parenthesis we are probably not in a funcall position.
222 ;; Maybe a `let' varlist or something.
223 nil
224 ;; Else, we assume that a function name is expected.
225 'fboundp))))
226
227(defun lisp-symbol-completion-transform ()
228 "`symbol-completion-transform-function' for Lisp."
229 (lambda (elt)
230 (if (and (not (eq 'fboundp symbol-completion-predicate))
231 (fboundp (intern elt)))
232 (list elt " <f>")
233 elt)))
234
235(provide 'sym-comp)
236
237;;; sym-comp.el ends here
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-19 11:49:52 +0000