diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/gnus/gnus-ems.el | 266 | ||||
| -rw-r--r-- | lisp/gnus/gnus-sync.el | 917 | ||||
| -rw-r--r-- | lisp/gnus/messcompat.el | 91 | ||||
| -rw-r--r-- | lisp/nxml/nxml-glyph.el | 423 | ||||
| -rw-r--r-- | lisp/nxml/nxml-uchnm.el | 251 | ||||
| -rw-r--r-- | lisp/obsolete/awk-mode.el | 124 | ||||
| -rw-r--r-- | lisp/obsolete/iso-acc.el | 489 | ||||
| -rw-r--r-- | lisp/obsolete/iso-insert.el | 630 | ||||
| -rw-r--r-- | lisp/obsolete/iso-swed.el | 150 | ||||
| -rw-r--r-- | lisp/obsolete/resume.el | 125 | ||||
| -rw-r--r-- | lisp/obsolete/scribe.el | 329 | ||||
| -rw-r--r-- | lisp/obsolete/spell.el | 171 | ||||
| -rw-r--r-- | lisp/obsolete/swedish.el | 160 | ||||
| -rw-r--r-- | lisp/obsolete/sym-comp.el | 237 |
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 @@ -;;; gnus-ems.el --- functions for making Gnus work under different Emacsen - -;; Copyright (C) 1995-2017 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;;; Code: - -(eval-when-compile - (require 'cl) - (require 'ring)) - -;;; Function aliases later to be redefined for XEmacs usage. - -(defvar gnus-mouse-2 [mouse-2]) -(defvar gnus-down-mouse-3 [down-mouse-3]) -(defvar gnus-down-mouse-2 [down-mouse-2]) -(defvar gnus-widget-button-keymap nil) -(defvar gnus-mode-line-modified - (if (featurep 'xemacs) - '("--**-" . "-----") - '("**" "--"))) - -(eval-and-compile - (autoload 'gnus-xmas-define "gnus-xmas") - (autoload 'gnus-xmas-redefine "gnus-xmas")) - -(autoload 'gnus-get-buffer-create "gnus") -(autoload 'nnheader-find-etc-directory "nnheader") -(autoload 'smiley-region "smiley") - -(defun gnus-kill-all-overlays () - "Delete all overlays in the current buffer." - (let* ((overlayss (overlay-lists)) - (buffer-read-only nil) - (overlays (delq nil (nconc (car overlayss) (cdr overlayss))))) - (while overlays - (delete-overlay (pop overlays))))) - -;;; Mule functions. - -(defun gnus-mule-max-width-function (el max-width) - `(let* ((val (eval (, el))) - (valstr (if (numberp val) - (int-to-string val) val))) - (if (> (length valstr) ,max-width) - (truncate-string-to-width valstr ,max-width) - valstr))) - -(eval-and-compile - (if (featurep 'xemacs) - (gnus-xmas-define) - (defvar gnus-mouse-face-prop 'mouse-face - "Property used for highlighting mouse regions."))) - -(defvar gnus-tmp-unread) -(defvar gnus-tmp-replied) -(defvar gnus-tmp-score-char) -(defvar gnus-tmp-indentation) -(defvar gnus-tmp-opening-bracket) -(defvar gnus-tmp-lines) -(defvar gnus-tmp-name) -(defvar gnus-tmp-closing-bracket) -(defvar gnus-tmp-subject-or-nil) -(defvar gnus-check-before-posting) -(defvar gnus-mouse-face) -(defvar gnus-group-buffer) - -(defun gnus-ems-redefine () - (cond - ((featurep 'xemacs) - (gnus-xmas-redefine)) - - ((featurep 'mule) - ;; Mule and new Emacs definitions - - ;; [Note] Now there are three kinds of mule implementations, - ;; original MULE, XEmacs/mule and Emacs 20+ including - ;; MULE features. Unfortunately these APIs are different. In - ;; particular, Emacs (including original Mule) and XEmacs are - ;; quite different. However, this version of Gnus doesn't support - ;; anything other than XEmacs 20+ and Emacs 20.3+. - - ;; Predicates to check are following: - ;; (boundp 'MULE) is t only if Mule (original; anything older than - ;; Mule 2.3) is running. - ;; (featurep 'mule) is t when other mule variants are running. - - ;; It is possible to detect XEmacs/mule by (featurep 'mule) and - ;; (featurep 'xemacs). In this case, the implementation for - ;; XEmacs/mule may be shareable between XEmacs and XEmacs/mule. - - (defvar gnus-summary-display-table nil - "Display table used in summary mode buffers.") - (defalias 'gnus-max-width-function 'gnus-mule-max-width-function) - - (when (boundp 'gnus-check-before-posting) - (setq gnus-check-before-posting - (delq 'long-lines - (delq 'control-chars gnus-check-before-posting)))) - - (defun gnus-summary-line-format-spec () - (insert gnus-tmp-unread gnus-tmp-replied - gnus-tmp-score-char gnus-tmp-indentation) - (put-text-property - (point) - (progn - (insert - gnus-tmp-opening-bracket - (format "%4d: %-20s" - gnus-tmp-lines - (if (> (length gnus-tmp-name) 20) - (truncate-string-to-width gnus-tmp-name 20) - gnus-tmp-name)) - gnus-tmp-closing-bracket) - (point)) - gnus-mouse-face-prop gnus-mouse-face) - (insert " " gnus-tmp-subject-or-nil "\n"))))) - -;; Clone of `appt-select-lowest-window' in appt.el. -(defun gnus-select-lowest-window () -"Select the lowest window on the frame." - (let ((lowest-window (selected-window)) - (bottom-edge (nth 3 (window-edges)))) - (walk-windows (lambda (w) - (let ((next-bottom-edge (nth 3 (window-edges w)))) - (when (< bottom-edge next-bottom-edge) - (setq bottom-edge next-bottom-edge - lowest-window w))))) - (select-window lowest-window))) - -(defun gnus-region-active-p () - "Say whether the region is active." - (and (boundp 'transient-mark-mode) - transient-mark-mode - (boundp 'mark-active) - mark-active)) - -(defun gnus-mark-active-p () - "Non-nil means the mark and region are currently active in this buffer." - mark-active) ; aliased to region-exists-p in XEmacs. - -(autoload 'gnus-alive-p "gnus-util") -(autoload 'mm-disable-multibyte "mm-util") - -;;; Image functions. - -(defun gnus-image-type-available-p (type) - (and (fboundp 'image-type-available-p) - (if (fboundp 'display-images-p) - (display-images-p) - t) - (image-type-available-p type))) - -(defun gnus-create-image (file &optional type data-p &rest props) - (let ((face (plist-get props :face))) - (when face - (setq props (plist-put props :foreground (face-foreground face))) - (setq props (plist-put props :background (face-background face)))) - (ignore-errors - (apply 'create-image file type data-p props)))) - -(defun gnus-put-image (glyph &optional string category) - (let ((point (point))) - (insert-image glyph (or string " ")) - (put-text-property point (point) 'gnus-image-category category) - (unless string - (put-text-property (1- (point)) (point) - 'gnus-image-text-deletable t)) - glyph)) - -(defun gnus-remove-image (image &optional category) - "Remove the image matching IMAGE and CATEGORY found first." - (let ((start (point-min)) - val end) - (while (and (not end) - (or (setq val (get-text-property start 'display)) - (and (setq start - (next-single-property-change start 'display)) - (setq val (get-text-property start 'display))))) - (setq end (or (next-single-property-change start 'display) - (point-max))) - (if (and (equal val image) - (equal (get-text-property start 'gnus-image-category) - category)) - (progn - (put-text-property start end 'display nil) - (when (get-text-property start 'gnus-image-text-deletable) - (delete-region start end))) - (unless (= end (point-max)) - (setq start end - end nil)))))) - -(defmacro gnus-string-mark-left-to-right (string) - (if (fboundp 'bidi-string-mark-left-to-right) - `(bidi-string-mark-left-to-right ,string) - string)) - -(eval-and-compile - ;; XEmacs does not have window-inside-pixel-edges - (defalias 'gnus-window-inside-pixel-edges - (if (fboundp 'window-inside-pixel-edges) - 'window-inside-pixel-edges - 'window-pixel-edges)) - - (if (or (featurep 'emacs) (fboundp 'set-process-plist)) - (progn ; these exist since Emacs 22.1 - (defalias 'gnus-set-process-plist 'set-process-plist) - (defalias 'gnus-process-plist 'process-plist) - (defalias 'gnus-process-get 'process-get) - (defalias 'gnus-process-put 'process-put)) - (defun gnus-set-process-plist (process plist) - "Replace the plist of PROCESS with PLIST. Returns PLIST." - (put 'gnus-process-plist-internal process plist)) - - (defun gnus-process-plist (process) - "Return the plist of PROCESS." - ;; This form works but can't prevent the plist data from - ;; growing infinitely. - ;;(get 'gnus-process-plist-internal process) - (let* ((plist (symbol-plist 'gnus-process-plist-internal)) - (tem (memq process plist))) - (prog1 - (cadr tem) - ;; Remove it from the plist data. - (when tem - (if (eq plist tem) - (progn - (setcar plist (caddr plist)) - (setcdr plist (or (cdddr plist) '(nil)))) - (setcdr (nthcdr (- (length plist) (length tem) 1) plist) - (cddr tem))))))) - - (defun gnus-process-get (process propname) - "Return the value of PROCESS' PROPNAME property. -This is the last value stored with `(gnus-process-put PROCESS PROPNAME VALUE)'." - (plist-get (gnus-process-plist process) propname)) - - (defun gnus-process-put (process propname value) - "Change PROCESS' PROPNAME property to VALUE. -It can be retrieved with `(gnus-process-get PROCESS PROPNAME)'." - (gnus-set-process-plist process - (plist-put (gnus-process-plist process) - propname value))))) - -(provide 'gnus-ems) - -;;; 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 @@ -;;; gnus-sync.el --- synchronization facility for Gnus - -;; Copyright (C) 2010-2017 Free Software Foundation, Inc. - -;; Author: Ted Zlatanov <tzz@lifelogs.com> -;; Keywords: news synchronization nntp nnrss - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This is the gnus-sync.el package. - -;; Put this in your startup file (~/.gnus.el for instance) - -;; possibilities for gnus-sync-backend: -;; Tramp over SSH: /ssh:user@host:/path/to/filename -;; ...or any other file Tramp and Emacs can handle... - -;; (setq gnus-sync-backend "/remote:/path.gpg" ; will use Tramp+EPA if loaded -;; gnus-sync-global-vars '(gnus-newsrc-last-checked-date) -;; gnus-sync-newsrc-groups '("nntp" "nnrss")) -;; gnus-sync-newsrc-offsets '(2 3)) -;; against a LeSync server (beware the vampire LeSync, who knows your newsrc) - -;; (setq gnus-sync-backend '(lesync "http://lesync.info:5984/tzz") -;; gnus-sync-newsrc-groups '("nntp" "nnrss")) - -;; What's a LeSync server? - -;; 1. install CouchDB, set up a real server admin user, and create a -;; database, e.g. "tzz" and save the URL, -;; e.g. http://lesync.info:5984/tzz - -;; 2. run `M-: (gnus-sync-lesync-setup "http://lesync.info:5984/tzz" "tzzadmin" "mypassword" "mysalt" t t)' - -;; (If you run it more than once, you have to remove the entry from -;; _users yourself. This is intentional. This sets up a database -;; admin for the "tzz" database, distinct from the server admin -;; user in (1) above.) - -;; That's it, you can start using http://lesync.info:5984/tzz in your -;; gnus-sync-backend as a LeSync backend. Fan fiction about the -;; vampire LeSync is welcome. - -;; You may not want to expose a CouchDB install to the Big Bad -;; Internet, especially if your love of all things furry would be thus -;; revealed. Make sure it's not accessible by unauthorized users and -;; guests, at least. - -;; If you want to try it out, I will create a test DB for you under -;; http://lesync.info:5984/yourfavoritedbname - -;; TODO: - -;; - after gnus-sync-read, the message counts look wrong until you do -;; `g'. So it's not run automatically, you have to call it with M-x -;; gnus-sync-read - -;; - use gnus-after-set-mark-hook and gnus-before-update-mark-hook to -;; catch the mark updates - -;; - repositioning of groups within topic after a LeSync sync is a -;; weird sort of bubble sort ("buttle" sort: the old entry ends up -;; at the rear of the list); you will eventually end up with the -;; right order after calling `gnus-sync-read' a bunch of times. - -;; - installing topics and groups is inefficient and annoying, lots of -;; prompts could be avoided - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'json) -(require 'gnus) -(require 'gnus-start) -(require 'gnus-util) - -(defvar gnus-topic-alist) ;; gnus-group.el -(autoload 'gnus-group-topic "gnus-topic") - -(defgroup gnus-sync nil - "The Gnus synchronization facility." - :version "24.1" - :group 'gnus) - -(defcustom gnus-sync-newsrc-groups '("nntp" "nnrss") - "List of groups to be synchronized in the gnus-newsrc-alist. -The group names are matched, they don't have to be fully -qualified. Typically you would choose all of these. That's the -default because there is no active sync backend by default, so -this setting is harmless until the user chooses a sync backend." - :group 'gnus-sync - :type '(repeat regexp)) - -(defcustom gnus-sync-newsrc-offsets '(2 3) - "List of per-group data to be synchronized." - :group 'gnus-sync - :version "24.4" - :type '(set (const :tag "Read ranges" 2) - (const :tag "Marks" 3))) - -(defcustom gnus-sync-global-vars nil - "List of global variables to be synchronized. -You may want to sync `gnus-newsrc-last-checked-date' but pretty -much any symbol is fair game. You could additionally sync -`gnus-newsrc-alist', `gnus-server-alist', `gnus-topic-topology', -and `gnus-topic-alist'. Also see `gnus-variable-list'." - :group 'gnus-sync - :type '(repeat (choice (variable :tag "A known variable") - (symbol :tag "Any symbol")))) - -(defcustom gnus-sync-backend nil - "The synchronization backend." - :group 'gnus-sync - :type '(radio (const :format "None" nil) - (list :tag "Sync server" - (const :format "LeSync Server API" lesync) - (string :tag "URL of a CouchDB database for API access")) - (string :tag "Sync to a file"))) - -(defvar gnus-sync-newsrc-loader nil - "Carrier for newsrc data") - -(defcustom gnus-sync-file-encrypt-to nil - "If non-nil, set `epa-file-encrypt-to' from this for encrypting the Sync file." - :version "24.4" - :type '(choice string (repeat string)) - :group 'gnus-sync) - -(defcustom gnus-sync-lesync-name (system-name) - "The LeSync name for this machine." - :group 'gnus-sync - :version "24.3" - :type 'string) - -(defcustom gnus-sync-lesync-install-topics 'ask - "Should LeSync install the recorded topics?" - :group 'gnus-sync - :version "24.3" - :type '(choice (const :tag "Never Install" nil) - (const :tag "Always Install" t) - (const :tag "Ask Me Once" ask))) - -(defvar gnus-sync-lesync-props-hash (make-hash-table :test 'equal) - "LeSync props, keyed by group name") - -(defvar gnus-sync-lesync-design-prefix "/_design/lesync" - "The LeSync design prefix for CouchDB") - -(defvar gnus-sync-lesync-security-object "/_security" - "The LeSync security object for CouchDB") - -(defun gnus-sync-lesync-parse () - "Parse the result of a LeSync request." - (goto-char (point-min)) - (condition-case nil - (when (search-forward-regexp "^$" nil t) - (json-read)) - (error - (gnus-message - 1 - "gnus-sync-lesync-parse: Could not read the LeSync response!") - nil))) - -(defun gnus-sync-lesync-call (url method headers &optional kvdata) - "Make an access request to URL using KVDATA and METHOD. -KVDATA must be an alist." - (let ((url-request-method method) - (url-request-extra-headers headers) - (url-request-data (if kvdata (json-encode kvdata) nil))) - (with-current-buffer (url-retrieve-synchronously url) - (let ((data (gnus-sync-lesync-parse))) - (gnus-message 12 "gnus-sync-lesync-call: %s URL %s sent %S got %S" - method url `((headers . ,headers) (data ,kvdata)) data) - (kill-buffer (current-buffer)) - data)))) - -(defun gnus-sync-lesync-PUT (url headers &optional data) - (gnus-sync-lesync-call url "PUT" headers data)) - -(defun gnus-sync-lesync-POST (url headers &optional data) - (gnus-sync-lesync-call url "POST" headers data)) - -(defun gnus-sync-lesync-GET (url headers &optional data) - (gnus-sync-lesync-call url "GET" headers data)) - -(defun gnus-sync-lesync-DELETE (url headers &optional data) - (gnus-sync-lesync-call url "DELETE" headers data)) - -;; this is not necessary with newer versions of json.el but 1.2 or older -;; (which are in Emacs 24.1 and earlier) need it -(defun gnus-sync-json-alist-p (list) - "Non-null if and only if LIST is an alist." - (while (consp list) - (setq list (if (consp (car list)) - (cdr list) - 'not-alist))) - (null list)) - -;; this is not necessary with newer versions of json.el but 1.2 or older -;; (which are in Emacs 24.1 and earlier) need it -(defun gnus-sync-json-plist-p (list) - "Non-null if and only if LIST is a plist." - (while (consp list) - (setq list (if (and (keywordp (car list)) - (consp (cdr list))) - (cddr list) - 'not-plist))) - (null list)) - -; (gnus-sync-lesync-setup "http://lesync.info:5984/tzz" "tzzadmin" "mypassword" "mysalt" t t) -; (gnus-sync-lesync-setup "http://lesync.info:5984/tzz") - -(defun gnus-sync-lesync-setup (url &optional user password salt reader admin) - (interactive "sEnter URL to set up: ") - "Set up the LeSync database at URL. -Install USER as a READER and/or an ADMIN in the security object -under \"_security\", and in the CouchDB \"_users\" table using -PASSWORD and SALT. Only one USER is thus supported for now. -When SALT is nil, a random one will be generated using `random'." - (let* ((design-url (concat url gnus-sync-lesync-design-prefix)) - (security-object (concat url "/_security")) - (user-record `((names . [,user]) (roles . []))) - (couch-user-name (format "org.couchdb.user:%s" user)) - (salt (or salt (sha1 (format "%s" (random))))) - (couch-user-record - `((_id . ,couch-user-name) - (type . user) - (name . ,(format "%s" user)) - (roles . []) - (salt . ,salt) - (password_sha . ,(when password - (sha1 - (format "%s%s" password salt)))))) - (rev (progn - (gnus-sync-lesync-find-prop 'rev design-url design-url) - (gnus-sync-lesync-get-prop 'rev design-url))) - (latest-func "function(head,req) -{ - var tosend = []; - var row; - var ftime = (req.query['ftime'] || 0); - while (row = getRow()) - { - if (row.value['float-time'] > ftime) - { - var s = row.value['_id']; - if (s) tosend.push('\"'+s.replace('\"', '\\\"')+'\"'); - } - } - send('['+tosend.join(',') + ']'); -}") -;; <key>read</key> -;; <dict> -;; <key>de.alt.fan.ipod</key> -;; <array> -;; <integer>1</integer> -;; <integer>2</integer> -;; <dict> -;; <key>start</key> -;; <integer>100</integer> -;; <key>length</key> -;; <integer>100</integer> -;; </dict> -;; </array> -;; </dict> - (xmlplistread-func "function(head, req) { - var row; - start({ 'headers': { 'Content-Type': 'text/xml' } }); - - send('<dict>'); - send('<key>read</key>'); - send('<dict>'); - while(row = getRow()) - { - var read = row.value.read; - if (read && read[0] && read[0] == 'invlist') - { - send('<key>'+row.key+'</key>'); - //send('<invlist>'+read+'</invlist>'); - send('<array>'); - - var from = 0; - var flip = false; - - for (var i = 1; i < read.length && read[i]; i++) - { - var cur = read[i]; - if (flip) - { - if (from == cur-1) - { - send('<integer>'+read[i]+'</integer>'); - } - else - { - send('<dict>'); - send('<key>start</key>'); - send('<integer>'+from+'</integer>'); - send('<key>end</key>'); - send('<integer>'+(cur-1)+'</integer>'); - send('</dict>'); - } - - } - flip = ! flip; - from = cur; - } - send('</array>'); - } - } - - send('</dict>'); - send('</dict>'); -} -") - (subs-func "function(doc){emit([doc._id, doc.source], doc._rev);}") - (revs-func "function(doc){emit(doc._id, doc._rev);}") - (bytimesubs-func "function(doc) -{emit([(doc['float-time']||0), doc._id], doc._rev);}") - (bytime-func "function(doc) -{emit([(doc['float-time']||0), doc._id], doc);}") - (groups-func "function(doc){emit(doc._id, doc);}")) - (and (if user - (and (assq 'ok (gnus-sync-lesync-PUT - security-object - nil - (append (and reader - (list `(readers . ,user-record))) - (and admin - (list `(admins . ,user-record)))))) - (assq 'ok (gnus-sync-lesync-PUT - (concat (file-name-directory url) - "_users/" - couch-user-name) - nil - couch-user-record))) - t) - (assq 'ok (gnus-sync-lesync-PUT - design-url - nil - `(,@(when rev (list (cons '_rev rev))) - (lists . ((latest . ,latest-func) - (xmlplistread . ,xmlplistread-func))) - (views . ((subs . ((map . ,subs-func))) - (revs . ((map . ,revs-func))) - (bytimesubs . ((map . ,bytimesubs-func))) - (bytime . ((map . ,bytime-func))) - (groups . ((map . ,groups-func))))))))))) - -(defun gnus-sync-lesync-find-prop (prop url key) - "Retrieve a PROPerty of a document KEY at URL. -Calls `gnus-sync-lesync-set-prop'. -For the 'rev PROP, uses '_rev against the document." - (gnus-sync-lesync-set-prop - prop key (cdr (assq (if (eq prop 'rev) '_rev prop) - (gnus-sync-lesync-GET url nil))))) - -(defun gnus-sync-lesync-set-prop (prop key val) - "Update the PROPerty of document KEY at URL to VAL. -Updates `gnus-sync-lesync-props-hash'." - (puthash (format "%s.%s" key prop) val gnus-sync-lesync-props-hash)) - -(defun gnus-sync-lesync-get-prop (prop key) - "Get the PROPerty of KEY from `gnus-sync-lesync-props-hash'." - (gethash (format "%s.%s" key prop) gnus-sync-lesync-props-hash)) - -(defun gnus-sync-deep-print (data) - (let* ((print-quoted t) - (print-readably t) - (print-escape-multibyte nil) - (print-escape-nonascii t) - (print-length nil) - (print-level nil) - (print-circle nil) - (print-escape-newlines t)) - (format "%S" data))) - -(defun gnus-sync-newsrc-loader-builder (&optional only-modified) - (let* ((entries (cdr gnus-newsrc-alist)) - entry name ret) - (while entries - (setq entry (pop entries) - name (car entry)) - (when (gnus-grep-in-list name gnus-sync-newsrc-groups) - (if only-modified - (when (not (equal (gnus-sync-deep-print entry) - (gnus-sync-lesync-get-prop 'checksum name))) - (gnus-message 9 "%s: add %s, it's modified" - "gnus-sync-newsrc-loader-builder" name) - (push entry ret)) - (push entry ret)))) - ret)) - -; (json-encode (gnus-sync-range2invlist '((1 . 47137) (47139 . 47714) 48129 48211 49231 49281 49342 49473 49475 49502))) -(defun gnus-sync-range2invlist (ranges) - (append '(invlist) - (let ((ranges (delq nil ranges)) - ret range from to) - (while ranges - (setq range (pop ranges)) - (if (atom range) - (setq from range - to range) - (setq from (car range) - to (cdr range))) - (push from ret) - (push (1+ to) ret)) - (reverse ret)))) - -; (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)) -(defun gnus-sync-invlist2range (inv) - (setq inv (append inv nil)) - (if (equal (format "%s" (car inv)) "invlist") - (let ((i (cdr inv)) - (start 0) - ret cur top flip) - (while i - (setq cur (pop i)) - (when flip - (setq top (1- cur)) - (if (= start top) - (push start ret) - (push (cons start top) ret))) - (setq flip (not flip)) - (setq start cur)) - (reverse ret)) - inv)) - -(defun gnus-sync-position (search list &optional test) - "Find the position of SEARCH in LIST using TEST, defaulting to `eq'." - (let ((pos 0) - (test (or test 'eq))) - (while (and list (not (funcall test (car list) search))) - (pop list) - (incf pos)) - (if (funcall test (car list) search) pos nil))) - -(defun gnus-sync-topic-group-position (group topic-name) - (gnus-sync-position - group (cdr (assoc topic-name gnus-topic-alist)) 'equal)) - -(defun gnus-sync-fix-topic-group-position (group topic-name position) - (unless (equal position (gnus-sync-topic-group-position group topic-name)) - (let* ((loc "gnus-sync-fix-topic-group-position") - (groups (delete group (cdr (assoc topic-name gnus-topic-alist)))) - (position (min position (1- (length groups)))) - (old (nth position groups))) - (when (and old (not (equal old group))) - (setf (nth position groups) group) - (setcdr (assoc topic-name gnus-topic-alist) - (append groups (list old))) - (gnus-message 9 "%s: %s moved to %d, swap with %s" - loc group position old))))) - -(defun gnus-sync-lesync-pre-save-group-entry (url nentry &rest passed-props) - (let* ((loc "gnus-sync-lesync-save-group-entry") - (k (car nentry)) - (revision (gnus-sync-lesync-get-prop 'rev k)) - (sname gnus-sync-lesync-name) - (topic (gnus-group-topic k)) - (topic-offset (gnus-sync-topic-group-position k topic)) - (sources (gnus-sync-lesync-get-prop 'source k))) - ;; set the revision so we don't have a conflict - `(,@(when revision - (list (cons '_rev revision))) - (_id . ,k) - ;; the time we saved - ,@passed-props - ;; add our name to the sources list for this key - (source ,@(if (member gnus-sync-lesync-name sources) - sources - (cons gnus-sync-lesync-name sources))) - ,(cons 'level (nth 1 nentry)) - ,@(if topic (list (cons 'topic topic)) nil) - ,@(if topic-offset (list (cons 'topic-offset topic-offset)) nil) - ;; the read marks - ,(cons 'read (gnus-sync-range2invlist (nth 2 nentry))) - ;; the other marks - ,@(delq nil (mapcar (lambda (mark-entry) - (gnus-message 12 "%s: prep param %s in %s" - loc - (car mark-entry) - (nth 3 nentry)) - (if (listp (cdr mark-entry)) - (cons (car mark-entry) - (gnus-sync-range2invlist - (cdr mark-entry))) - (progn ; else this is not a list - (gnus-message 9 "%s: non-list param %s in %s" - loc - (car mark-entry) - (nth 3 nentry)) - nil))) - (nth 3 nentry)))))) - -(defun gnus-sync-lesync-post-save-group-entry (url entry) - (let* ((loc "gnus-sync-lesync-post-save-group-entry") - (k (cdr (assq 'id entry)))) - (cond - ;; success! - ((and (assq 'rev entry) (assq 'id entry)) - (progn - (gnus-sync-lesync-set-prop 'rev k (cdr (assq 'rev entry))) - (gnus-sync-lesync-set-prop 'checksum - k - (gnus-sync-deep-print - (assoc k gnus-newsrc-alist))) - (gnus-message 9 "%s: successfully synced %s to %s" - loc k url))) - ;; specifically check for document conflicts - ((equal "conflict" (format "%s" (cdr-safe (assq 'error entry)))) - (gnus-error - 1 - "%s: use `%s' to resolve the conflict synchronizing %s to %s: %s" - loc "gnus-sync-read" k url (cdr (assq 'reason entry)))) - ;; generic errors - ((assq 'error entry) - (gnus-error 1 "%s: got error while synchronizing %s to %s: %s" - loc k url (cdr (assq 'reason entry)))) - - (t - (gnus-message 2 "%s: unknown sync status after %s to %s: %S" - loc k url entry))) - (assoc 'error entry))) - -(defun gnus-sync-lesync-groups-builder (url) - (let ((u (concat url gnus-sync-lesync-design-prefix "/_view/groups"))) - (cdr (assq 'rows (gnus-sync-lesync-GET u nil))))) - -(defun gnus-sync-subscribe-group (name) - "Subscribe to group NAME. Returns NAME on success, nil otherwise." - (gnus-subscribe-newsgroup name)) - -(defun gnus-sync-lesync-read-group-entry (url name entry &rest passed-props) - "Read ENTRY information for NAME. Returns NAME if successful. -Skips entries whose sources don't contain -`gnus-sync-lesync-name'. When the alist PASSED-PROPS has a -`subscribe-all' element that evaluates to true, we attempt to -subscribe to unknown groups. The user is also allowed to delete -unwanted groups via the LeSync URL." - (let* ((loc "gnus-sync-lesync-read-group-entry") - (entry (gnus-sync-lesync-normalize-group-entry entry passed-props)) - (subscribe-all (cdr (assq 'subscribe-all passed-props))) - (sources (cdr (assq 'source entry))) - (rev (cdr (assq 'rev entry))) - (in-sources (member gnus-sync-lesync-name sources)) - (known (assoc name gnus-newsrc-alist)) - cell) - (unless known - (if (and subscribe-all - (y-or-n-p (format "Subscribe to group %s?" name))) - (setq known (gnus-sync-subscribe-group name) - in-sources t) - ;; else... - (when (y-or-n-p (format "Delete group %s from server?" name)) - (if (equal name (gnus-sync-lesync-delete-group url name)) - (gnus-message 1 "%s: removed group %s from server %s" - loc name url) - (gnus-error 1 "%s: could not remove group %s from server %s" - loc name url))))) - (when known - (unless in-sources - (setq in-sources - (y-or-n-p - (format "Read group %s even though %s is not in sources %S?" - name gnus-sync-lesync-name (or sources "")))))) - (when rev - (gnus-sync-lesync-set-prop 'rev name rev)) - - ;; if the source matches AND we have this group - (if (and known in-sources) - (progn - (gnus-message 10 "%s: reading LeSync entry %s, sources %S" - loc name sources) - (while entry - (setq cell (pop entry)) - (let ((k (car cell)) - (val (cdr cell))) - (gnus-sync-lesync-set-prop k name val))) - name) - ;; else... - (unless known - (gnus-message 5 "%s: ignoring entry %s, it wasn't subscribed. %s" - loc name "Call `gnus-sync-read' with C-u to force it.")) - (unless in-sources - (gnus-message 5 "%s: ignoring entry %s, %s not in sources %S" - loc name gnus-sync-lesync-name (or sources ""))) - nil))) - -(declare-function gnus-topic-create-topic "gnus-topic" - (topic parent &optional previous full-topic)) -(declare-function gnus-topic-enter-dribble "gnus-topic" ()) - -(defun gnus-sync-lesync-install-group-entry (name) - (let* ((master (assoc name gnus-newsrc-alist)) - (old-topic-name (gnus-group-topic name)) - (old-topic (assoc old-topic-name gnus-topic-alist)) - (target-topic-name (gnus-sync-lesync-get-prop 'topic name)) - (target-topic-offset (gnus-sync-lesync-get-prop 'topic-offset name)) - (target-topic (assoc target-topic-name gnus-topic-alist)) - (loc "gnus-sync-lesync-install-group-entry")) - (if master - (progn - (when (eq 'ask gnus-sync-lesync-install-topics) - (setq gnus-sync-lesync-install-topics - (y-or-n-p "Install topics from LeSync?"))) - (when (and (eq t gnus-sync-lesync-install-topics) - target-topic-name) - (if (equal old-topic-name target-topic-name) - (gnus-message 12 "%s: %s is already in topic %s" - loc name target-topic-name) - ;; see `gnus-topic-move-group' - (when (and old-topic target-topic) - (setcdr old-topic (gnus-delete-first name (cdr old-topic))) - (gnus-message 5 "%s: removing %s from topic %s" - loc name old-topic-name)) - (unless target-topic - (when (y-or-n-p (format "Create missing topic %s?" - target-topic-name)) - (gnus-topic-create-topic target-topic-name nil) - (setq target-topic (assoc target-topic-name - gnus-topic-alist)))) - (if target-topic - (prog1 - (nconc target-topic (list name)) - (gnus-message 5 "%s: adding %s to topic %s" - loc name (car target-topic)) - (gnus-topic-enter-dribble)) - (gnus-error 2 "%s: LeSync group %s can't go in missing topic %s" - loc name target-topic-name))) - (when (and target-topic-offset target-topic) - (gnus-sync-fix-topic-group-position - name target-topic-name target-topic-offset))) - ;; install the subscription level - (when (gnus-sync-lesync-get-prop 'level name) - (setf (nth 1 master) (gnus-sync-lesync-get-prop 'level name))) - ;; install the read and other marks - (setf (nth 2 master) (gnus-sync-lesync-get-prop 'read name)) - (setf (nth 3 master) (gnus-sync-lesync-get-prop 'marks name)) - (gnus-sync-lesync-set-prop 'checksum - name - (gnus-sync-deep-print master)) - nil) - (gnus-error 1 "%s: invalid LeSync group %s" loc name) - 'invalid-name))) - -; (gnus-sync-lesync-delete-group (cdr gnus-sync-backend) "nntp+Gmane:gwene.org.slashdot") - -(defun gnus-sync-lesync-delete-group (url name) - "Returns NAME if successful deleting it from URL, an error otherwise." - (interactive "sEnter URL to set up: \rsEnter group name: ") - (let* ((u (concat (cadr gnus-sync-backend) "/" (url-hexify-string name))) - (del (gnus-sync-lesync-DELETE - u - `(,@(when (gnus-sync-lesync-get-prop 'rev name) - (list (cons "If-Match" - (gnus-sync-lesync-get-prop 'rev name)))))))) - (or (cdr (assq 'id del)) del))) - -;;; (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))) - -(defun gnus-sync-lesync-normalize-group-entry (entry &optional passed-props) - (let (ret - marks - cell) - (setq entry (append passed-props entry)) - (while (setq cell (pop entry)) - (let ((k (car cell)) - (val (cdr cell))) - (cond - ((eq k 'read) - (push (cons k (gnus-sync-invlist2range val)) ret)) - ;; we ignore these parameters - ((member k '(_id subscribe-all _deleted_conflicts)) - nil) - ((eq k '_rev) - (push (cons 'rev val) ret)) - ((eq k 'source) - (push (cons 'source (append val nil)) ret)) - ((or (eq k 'float-time) - (eq k 'level) - (eq k 'topic) - (eq k 'topic-offset) - (eq k 'read-time)) - (push (cons k val) ret)) -;;; "How often have I said to you that when you have eliminated the -;;; impossible, whatever remains, however improbable, must be the -;;; truth?" --Sherlock Holmes - ;; everything remaining must be a mark - (t (push (cons k (gnus-sync-invlist2range val)) marks))))) - (cons (cons 'marks marks) ret))) - -(defun gnus-sync-save (&optional force) -"Save the Gnus sync data to the backend. -With a prefix, FORCE is set and all groups will be saved." - (interactive "P") - (cond - ((and (listp gnus-sync-backend) - (eq (nth 0 gnus-sync-backend) 'lesync) - (stringp (nth 1 gnus-sync-backend))) - - ;; refresh the revisions if we're forcing the save - (when force - (mapc (lambda (entry) - (when (and (assq 'key entry) - (assq 'value entry)) - (gnus-sync-lesync-set-prop - 'rev - (cdr (assq 'key entry)) - (cdr (assq 'value entry))))) - ;; the revs view is key = name, value = rev - (cdr (assq 'rows (gnus-sync-lesync-GET - (concat (nth 1 gnus-sync-backend) - gnus-sync-lesync-design-prefix - "/_view/revs") - nil))))) - - (let* ((ftime (float-time)) - (url (nth 1 gnus-sync-backend)) - (entries - (mapcar (lambda (entry) - (gnus-sync-lesync-pre-save-group-entry - (cadr gnus-sync-backend) - entry - (cons 'float-time ftime))) - (gnus-sync-newsrc-loader-builder (not force)))) - ;; when there are no entries, there's nothing to save - (sync (if entries - (gnus-sync-lesync-POST - (concat url "/_bulk_docs") - '(("Content-Type" . "application/json")) - `((docs . ,(vconcat entries nil)))) - (gnus-message - 2 "gnus-sync-save: nothing to save to the LeSync backend") - nil))) - (mapcar (lambda (e) (gnus-sync-lesync-post-save-group-entry url e)) - sync))) - ((stringp gnus-sync-backend) - (gnus-message 7 "gnus-sync-save: saving to backend %s" gnus-sync-backend) - ;; populate gnus-sync-newsrc-loader from all but the first dummy - ;; entry in gnus-newsrc-alist whose group matches any of the - ;; gnus-sync-newsrc-groups - ;; TODO: keep the old contents for groups we don't have! - (let ((gnus-sync-newsrc-loader - (loop for entry in (cdr gnus-newsrc-alist) - when (gnus-grep-in-list - (car entry) ;the group name - gnus-sync-newsrc-groups) - collect (cons (car entry) - (mapcar (lambda (offset) - (cons offset (nth offset entry))) - gnus-sync-newsrc-offsets))))) - (with-temp-file gnus-sync-backend - (progn - (let ((coding-system-for-write gnus-ding-file-coding-system) - (standard-output (current-buffer))) - (when gnus-sync-file-encrypt-to - (set (make-local-variable 'epa-file-encrypt-to) - gnus-sync-file-encrypt-to)) - (princ (format ";; -*- mode:emacs-lisp; coding: %s; -*-\n" - gnus-ding-file-coding-system)) - (princ ";; Gnus sync data v. 0.0.1\n") - ;; TODO: replace with `gnus-sync-deep-print' - (let* ((print-quoted t) - (print-readably t) - (print-escape-multibyte nil) - (print-escape-nonascii t) - (print-length nil) - (print-level nil) - (print-circle nil) - (print-escape-newlines t) - (variables (cons 'gnus-sync-newsrc-loader - gnus-sync-global-vars)) - variable) - (while variables - (if (and (boundp (setq variable (pop variables))) - (symbol-value variable)) - (progn - (princ "\n(setq ") - (princ (symbol-name variable)) - (princ " '") - (prin1 (symbol-value variable)) - (princ ")\n")) - (princ "\n;;; skipping empty variable ") - (princ (symbol-name variable))))) - (gnus-message - 7 - "gnus-sync-save: stored variables %s and %d groups in %s" - gnus-sync-global-vars - (length gnus-sync-newsrc-loader) - gnus-sync-backend) - - ;; Idea from Dan Christensen <jdc@chow.mat.jhu.edu> - ;; Save the .eld file with extra line breaks. - (gnus-message 8 "gnus-sync-save: adding whitespace to %s" - gnus-sync-backend) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "^(\\|(\\\"" nil t) - (replace-match "\n\\&" t)) - (goto-char (point-min)) - (while (re-search-forward " $" nil t) - (replace-match "" t t)))))))) - ;; the pass-through case: gnus-sync-backend is not a known choice - (nil))) - -(defun gnus-sync-read (&optional subscribe-all) - "Load the Gnus sync data from the backend. -With a prefix, SUBSCRIBE-ALL is set and unknown groups will be subscribed." - (interactive "P") - (when gnus-sync-backend - (gnus-message 7 "gnus-sync-read: loading from backend %s" gnus-sync-backend) - (cond - ((and (listp gnus-sync-backend) - (eq (nth 0 gnus-sync-backend) 'lesync) - (stringp (nth 1 gnus-sync-backend))) - (let ((errored nil) - name ftime) - (mapc (lambda (entry) - (setq name (cdr (assq 'id entry))) - ;; set ftime the FIRST time through this loop, that - ;; way it reflects the time we FINISHED reading - (unless ftime (setq ftime (float-time))) - - (unless errored - (setq errored - (when (equal name - (gnus-sync-lesync-read-group-entry - (nth 1 gnus-sync-backend) - name - (cdr (assq 'value entry)) - `(read-time ,ftime) - `(subscribe-all ,subscribe-all))) - (gnus-sync-lesync-install-group-entry - (cdr (assq 'id entry))))))) - (gnus-sync-lesync-groups-builder (nth 1 gnus-sync-backend))))) - - ((stringp gnus-sync-backend) - ;; read data here... - (if (or debug-on-error debug-on-quit) - (load gnus-sync-backend nil t) - (condition-case var - (load gnus-sync-backend nil t) - (error - (error "Error in %s: %s" gnus-sync-backend (cadr var))))) - (let ((valid-count 0) - invalid-groups) - (dolist (node gnus-sync-newsrc-loader) - (if (gnus-gethash (car node) gnus-newsrc-hashtb) - (progn - (incf valid-count) - (loop for store in (cdr node) - do (setf (nth (car store) - (assoc (car node) gnus-newsrc-alist)) - (cdr store)))) - (push (car node) invalid-groups))) - (gnus-message - 7 - "gnus-sync-read: loaded %d groups (out of %d) from %s" - valid-count (length gnus-sync-newsrc-loader) - gnus-sync-backend) - (when invalid-groups - (gnus-message - 7 - "gnus-sync-read: skipped %d groups (out of %d) from %s" - (length invalid-groups) - (length gnus-sync-newsrc-loader) - gnus-sync-backend) - (gnus-message 9 "gnus-sync-read: skipped groups: %s" - (mapconcat 'identity invalid-groups ", "))))) - (nil)) - - (gnus-message 9 "gnus-sync-read: remaking the newsrc hashtable") - (gnus-make-hashtable-from-newsrc-alist))) - -;;;###autoload -(defun gnus-sync-initialize () -"Initialize the Gnus sync facility." - (interactive) - (gnus-message 5 "Initializing the sync facility") - (gnus-sync-install-hooks)) - -;;;###autoload -(defun gnus-sync-install-hooks () - "Install the sync hooks." - (interactive) - ;; (add-hook 'gnus-get-new-news-hook 'gnus-sync-read) - ;; (add-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read) - (add-hook 'gnus-save-newsrc-hook 'gnus-sync-save)) - -(defun gnus-sync-unload-hook () - "Uninstall the sync hooks." - (interactive) - (remove-hook 'gnus-save-newsrc-hook 'gnus-sync-save)) - -(add-hook 'gnus-sync-unload-hook 'gnus-sync-unload-hook) - -(when gnus-sync-backend (gnus-sync-initialize)) - -(provide 'gnus-sync) - -;;; 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 @@ -;;; messcompat.el --- making message mode compatible with mail mode - -;; Copyright (C) 1996-2017 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> -;; Keywords: mail, news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This file tries to provide backward compatibility with sendmail.el -;; for Message mode. It should be used by simply adding -;; -;; (require 'messcompat) -;; -;; to the .emacs file. Loading it after Message mode has been -;; loaded will have no effect. - -;;; Code: - -(require 'sendmail) - -(defvar message-from-style mail-from-style - "*Specifies how \"From\" headers look. - -If nil, they contain just the return address like: - king@grassland.com -If `parens', they look like: - king@grassland.com (Elvis Parsley) -If `angles', they look like: - Elvis Parsley <king@grassland.com> - -Otherwise, most addresses look like `angles', but they look like -`parens' if `angles' would need quoting and `parens' would not.") - -(defvar message-interactive mail-interactive - "Non-nil means when sending a message wait for and display errors. -nil means let mailer mail back a message to report errors.") - -(defvar message-setup-hook mail-setup-hook - "Normal hook, run each time a new outgoing message is initialized. -The function `message-setup' runs this hook.") - -(if (boundp 'mail-mode-hook) - (defvar message-mode-hook mail-mode-hook - "Hook run in message mode buffers.")) - -(defvar message-indentation-spaces mail-indentation-spaces - "*Number of spaces to insert at the beginning of each cited line. -Used by `message-yank-original' via `message-yank-cite'.") - -(defvar message-signature mail-signature - "*String to be inserted at the end of the message buffer. -If t, the `message-signature-file' file will be inserted instead. -If a function, the result from the function will be used instead. -If a form, the result from the form will be used instead.") - -;; Deleted the autoload cookie because this crashes in loaddefs.el. -(defvar message-signature-file mail-signature-file - "*File containing the text inserted at end of the message buffer.") - -(defvar message-default-headers mail-default-headers - "*A string containing header lines to be inserted in outgoing messages. -It is inserted before you edit the message, so you can edit or delete -these lines.") - -(defvar message-send-hook mail-send-hook - "Hook run before sending messages.") - -(defvar message-send-mail-function send-mail-function - "Function to call to send the current buffer as mail. -The headers should be delimited by a line whose contents match the -variable `mail-header-separator'.") - -(provide 'messcompat) - -;;; 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 @@ -;;; nxml-glyph.el --- glyph-handling for nxml-mode - -;; Copyright (C) 2003, 2007-2017 Free Software Foundation, Inc. - -;; Author: James Clark -;; Keywords: wp, hypermedia, languages, XML - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; The entry point to this file is `nxml-glyph-display-string'. -;; The current implementation is heuristic due to a lack of -;; Emacs primitives necessary to implement it properly. The user -;; can tweak the heuristics using `nxml-glyph-set-functions'. - -;;; Code: - -(defconst nxml-ascii-glyph-set - [(#x0020 . #x007E)]) - -(defconst nxml-latin1-glyph-set - [(#x0020 . #x007E) - (#x00A0 . #x00FF)]) - -;; These were generated by using nxml-insert-target-repertoire-glyph-set -;; on the TARGET[123] files in -;; http://www.cl.cam.ac.uk/~mgk25/download/ucs-fonts.tar.gz - -(defconst nxml-misc-fixed-1-glyph-set - [(#x0020 . #x007E) - (#x00A0 . #x00FF) - (#x0100 . #x017F) - #x018F #x0192 - (#x0218 . #x021B) - #x0259 - (#x02C6 . #x02C7) - (#x02D8 . #x02DD) - (#x0374 . #x0375) - #x037A #x037E - (#x0384 . #x038A) - #x038C - (#x038E . #x03A1) - (#x03A3 . #x03CE) - (#x0401 . #x040C) - (#x040E . #x044F) - (#x0451 . #x045C) - (#x045E . #x045F) - (#x0490 . #x0491) - (#x05D0 . #x05EA) - (#x1E02 . #x1E03) - (#x1E0A . #x1E0B) - (#x1E1E . #x1E1F) - (#x1E40 . #x1E41) - (#x1E56 . #x1E57) - (#x1E60 . #x1E61) - (#x1E6A . #x1E6B) - (#x1E80 . #x1E85) - (#x1EF2 . #x1EF3) - (#x2010 . #x2022) - #x2026 #x2030 - (#x2039 . #x203A) - #x20AC #x2116 #x2122 #x2126 - (#x215B . #x215E) - (#x2190 . #x2193) - #x2260 - (#x2264 . #x2265) - (#x23BA . #x23BD) - (#x2409 . #x240D) - #x2424 #x2500 #x2502 #x250C #x2510 #x2514 #x2518 #x251C #x2524 #x252C #x2534 #x253C #x2592 #x25C6 #x266A #xFFFD] - "Glyph set for TARGET1 glyph repertoire of misc-fixed-* font. -This repertoire is supported for the bold and oblique fonts.") - -(defconst nxml-misc-fixed-2-glyph-set - [(#x0020 . #x007E) - (#x00A0 . #x00FF) - (#x0100 . #x017F) - #x018F #x0192 - (#x01FA . #x01FF) - (#x0218 . #x021B) - #x0259 - (#x02C6 . #x02C7) - #x02C9 - (#x02D8 . #x02DD) - (#x0300 . #x0311) - (#x0374 . #x0375) - #x037A #x037E - (#x0384 . #x038A) - #x038C - (#x038E . #x03A1) - (#x03A3 . #x03CE) - #x03D1 - (#x03D5 . #x03D6) - #x03F1 - (#x0401 . #x040C) - (#x040E . #x044F) - (#x0451 . #x045C) - (#x045E . #x045F) - (#x0490 . #x0491) - (#x05D0 . #x05EA) - (#x1E02 . #x1E03) - (#x1E0A . #x1E0B) - (#x1E1E . #x1E1F) - (#x1E40 . #x1E41) - (#x1E56 . #x1E57) - (#x1E60 . #x1E61) - (#x1E6A . #x1E6B) - (#x1E80 . #x1E85) - (#x1EF2 . #x1EF3) - (#x2010 . #x2022) - #x2026 #x2030 - (#x2032 . #x2034) - (#x2039 . #x203A) - #x203C #x203E #x2044 - (#x2070 . #x2071) - (#x2074 . #x208E) - (#x20A3 . #x20A4) - #x20A7 #x20AC - (#x20D0 . #x20D7) - #x2102 #x2105 #x2113 - (#x2115 . #x2116) - #x211A #x211D #x2122 #x2124 #x2126 #x212E - (#x215B . #x215E) - (#x2190 . #x2195) - (#x21A4 . #x21A8) - (#x21D0 . #x21D5) - (#x2200 . #x2209) - (#x220B . #x220C) - #x220F - (#x2211 . #x2213) - #x2215 - (#x2218 . #x221A) - (#x221D . #x221F) - #x2221 - (#x2224 . #x222B) - #x222E #x223C #x2243 #x2245 - (#x2248 . #x2249) - #x2259 - (#x225F . #x2262) - (#x2264 . #x2265) - (#x226A . #x226B) - (#x2282 . #x228B) - #x2295 #x2297 - (#x22A4 . #x22A7) - (#x22C2 . #x22C3) - #x22C5 #x2300 #x2302 - (#x2308 . #x230B) - #x2310 - (#x2320 . #x2321) - (#x2329 . #x232A) - (#x23BA . #x23BD) - (#x2409 . #x240D) - #x2424 #x2500 #x2502 #x250C #x2510 #x2514 #x2518 #x251C #x2524 #x252C #x2534 #x253C - (#x254C . #x2573) - (#x2580 . #x25A1) - (#x25AA . #x25AC) - (#x25B2 . #x25B3) - #x25BA #x25BC #x25C4 #x25C6 - (#x25CA . #x25CB) - #x25CF - (#x25D8 . #x25D9) - #x25E6 - (#x263A . #x263C) - #x2640 #x2642 #x2660 #x2663 - (#x2665 . #x2666) - (#x266A . #x266B) - (#xFB01 . #xFB02) - #xFFFD] - "Glyph set for TARGET2 glyph repertoire of the misc-fixed-* fonts. -This repertoire is supported for the following fonts: -5x7.bdf 5x8.bdf 6x9.bdf 6x10.bdf 6x12.bdf 7x13.bdf 7x14.bdf clR6x12.bdf") - -(defconst nxml-misc-fixed-3-glyph-set - [(#x0020 . #x007E) - (#x00A0 . #x00FF) - (#x0100 . #x01FF) - (#x0200 . #x0220) - (#x0222 . #x0233) - (#x0250 . #x02AD) - (#x02B0 . #x02EE) - (#x0300 . #x034F) - (#x0360 . #x036F) - (#x0374 . #x0375) - #x037A #x037E - (#x0384 . #x038A) - #x038C - (#x038E . #x03A1) - (#x03A3 . #x03CE) - (#x03D0 . #x03F6) - (#x0400 . #x0486) - (#x0488 . #x04CE) - (#x04D0 . #x04F5) - (#x04F8 . #x04F9) - (#x0500 . #x050F) - (#x0531 . #x0556) - (#x0559 . #x055F) - (#x0561 . #x0587) - (#x0589 . #x058A) - (#x05B0 . #x05B9) - (#x05BB . #x05C4) - (#x05D0 . #x05EA) - (#x05F0 . #x05F4) - (#x10D0 . #x10F8) - #x10FB - (#x1E00 . #x1E9B) - (#x1EA0 . #x1EF9) - (#x1F00 . #x1F15) - (#x1F18 . #x1F1D) - (#x1F20 . #x1F45) - (#x1F48 . #x1F4D) - (#x1F50 . #x1F57) - #x1F59 #x1F5B #x1F5D - (#x1F5F . #x1F7D) - (#x1F80 . #x1FB4) - (#x1FB6 . #x1FC4) - (#x1FC6 . #x1FD3) - (#x1FD6 . #x1FDB) - (#x1FDD . #x1FEF) - (#x1FF2 . #x1FF4) - (#x1FF6 . #x1FFE) - (#x2000 . #x200A) - (#x2010 . #x2027) - (#x202F . #x2052) - #x2057 - (#x205F . #x2063) - (#x2070 . #x2071) - (#x2074 . #x208E) - (#x20A0 . #x20B1) - (#x20D0 . #x20EA) - (#x2100 . #x213A) - (#x213D . #x214B) - (#x2153 . #x2183) - (#x2190 . #x21FF) - (#x2200 . #x22FF) - (#x2300 . #x23CE) - (#x2400 . #x2426) - (#x2440 . #x244A) - (#x2500 . #x25FF) - (#x2600 . #x2613) - (#x2616 . #x2617) - (#x2619 . #x267D) - (#x2680 . #x2689) - (#x27E6 . #x27EB) - (#x27F5 . #x27FF) - (#x2A00 . #x2A06) - #x2A1D #x2A3F #x303F - (#xFB00 . #xFB06) - (#xFB13 . #xFB17) - (#xFB1D . #xFB36) - (#xFB38 . #xFB3C) - #xFB3E - (#xFB40 . #xFB41) - (#xFB43 . #xFB44) - (#xFB46 . #xFB4F) - (#xFE20 . #xFE23) - (#xFF61 . #xFF9F) - #xFFFD] - "Glyph set for TARGET3 glyph repertoire of the misc-fixed-* fonts. -This repertoire is supported for the following fonts: -6x13.bdf 8x13.bdf 9x15.bdf 9x18.bdf 10x20.bdf") - -(defconst nxml-wgl4-glyph-set - [(#x0020 . #x007E) - (#x00A0 . #x017F) - #x0192 - (#x01FA . #x01FF) - (#x02C6 . #x02C7) - #x02C9 - (#x02D8 . #x02DB) - #x02DD - (#x0384 . #x038A) - #x038C - (#x038E . #x03A1) - (#x03A3 . #x03CE) - (#x0401 . #x040C) - (#x040E . #x044F) - (#x0451 . #x045C) - (#x045E . #x045F) - (#x0490 . #x0491) - (#x1E80 . #x1E85) - (#x1EF2 . #x1EF3) - (#x2013 . #x2015) - (#x2017 . #x201E) - (#x2020 . #x2022) - #x2026 #x2030 - (#x2032 . #x2033) - (#x2039 . #x203A) - #x203C #x203E #x2044 #x207F - (#x20A3 . #x20A4) - #x20A7 #x20AC #x2105 #x2113 #x2116 #x2122 #x2126 #x212E - (#x215B . #x215E) - (#x2190 . #x2195) - #x21A8 #x2202 #x2206 #x220F - (#x2211 . #x2212) - #x2215 - (#x2219 . #x221A) - (#x221E . #x221F) - #x2229 #x222B #x2248 - (#x2260 . #x2261) - (#x2264 . #x2265) - #x2302 #x2310 - (#x2320 . #x2321) - #x2500 #x2502 #x250C #x2510 #x2514 #x2518 #x251C #x2524 - #x252C #x2534 #x253C - (#x2550 . #x256C) - #x2580 #x2584 #x2588 #x258C - (#x2590 . #x2593) - (#x25A0 . #x25A1) - (#x25AA . #x25AC) - #x25B2 #x25BA #x25BC #x25C4 - (#x25CA . #x25CB) - #x25CF - (#x25D8 . #x25D9) - #x25E6 - (#x263A . #x263C) - #x2640 #x2642 #x2660 #x2663 - (#x2665 . #x2666) - (#x266A . #x266B) - (#xFB01 . #xFB02)] - "Glyph set corresponding to Windows Glyph List 4.") - -(defvar nxml-glyph-set-functions nil - "Abnormal hook for determining the set of glyphs in a face. -Each function in this hook is called in turn, unless one of them -returns non-nil. Each function is called with a single argument -FACE. If it can determine the set of glyphs representable by -FACE, it must set the variable `nxml-glyph-set' and return -non-nil. Otherwise, it must return nil. - -The constants `nxml-ascii-glyph-set', `nxml-latin1-glyph-set', -`nxml-misc-fixed-1-glyph-set', `nxml-misc-fixed-2-glyph-set', -`nxml-misc-fixed-3-glyph-set' and `nxml-wgl4-glyph-set' are -predefined for use by `nxml-glyph-set-functions'.") - -(define-obsolete-variable-alias 'nxml-glyph-set-hook - 'nxml-glyph-set-functions "24.3") - -(defvar nxml-glyph-set nil - "Used by `nxml-glyph-set-functions' to return set of glyphs in a FACE. -This should dynamically bound by any function that runs -`nxml-glyph-set-functions'. The value must be either nil representing an -empty set or a vector. Each member of the vector is either a single -integer or a cons (FIRST . LAST) representing the range of integers -from FIRST to LAST. An integer represents a glyph with that Unicode -code-point. The vector must be ordered.") - -(defun nxml-x-set-glyph-set (face) - (setq nxml-glyph-set - (if (equal (face-attribute face :family) "misc-fixed") - nxml-misc-fixed-3-glyph-set - nxml-wgl4-glyph-set))) - -(defun nxml-w32-set-glyph-set (face) - (setq nxml-glyph-set nxml-wgl4-glyph-set)) - -(defun nxml-window-system-set-glyph-set (face) - (setq nxml-glyph-set nxml-latin1-glyph-set)) - -(defun nxml-terminal-set-glyph-set (face) - (setq nxml-glyph-set nxml-ascii-glyph-set)) - -(add-hook 'nxml-glyph-set-functions - (or (cdr (assq window-system - '((x . nxml-x-set-glyph-set) - (w32 . nxml-w32-set-glyph-set) - (nil . nxml-terminal-set-glyph-set)))) - 'nxml-window-system-set-glyph-set) - t) - -;;;###autoload -(defun nxml-glyph-display-string (n face) - "Return a string that can display a glyph for Unicode code-point N. -FACE gives the face that will be used for displaying the string. -Return nil if the face cannot display a glyph for N." - (let ((nxml-glyph-set nil)) - (run-hook-with-args-until-success 'nxml-glyph-set-functions face) - (and nxml-glyph-set - (nxml-glyph-set-contains-p n nxml-glyph-set) - (let ((ch (decode-char 'ucs n))) - (and ch (string ch)))))) - -(defun nxml-glyph-set-contains-p (n v) - (let ((start 0) - (end (length v)) - found mid mid-val mid-start-val mid-end-val) - (while (> end start) - (setq mid (+ start - (/ (- end start) 2))) - (setq mid-val (aref v mid)) - (if (consp mid-val) - (setq mid-start-val (car mid-val) - mid-end-val (cdr mid-val)) - (setq mid-start-val mid-val - mid-end-val mid-val)) - (cond ((and (<= mid-start-val n) - (<= n mid-end-val)) - (setq found t) - (setq start end)) - ((< n mid-start-val) - (setq end mid)) - (t - (setq start - (if (eq start mid) - end - mid))))) - found)) - -(provide 'nxml-glyph) - -;;; 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 @@ -;;; nxml-uchnm.el --- support for Unicode standard cha names in nxml-mode - -;; Copyright (C) 2003, 2007-2017 Free Software Foundation, Inc. - -;; Author: James Clark -;; Keywords: wp, hypermedia, languages, XML - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This enables the use of the character names defined in the Unicode -;; Standard. The use of the names can be controlled on a per-block -;; basis, so as both to reduce memory usage and loading time, -;; and to make completion work better. - -;;; Code: - -(require 'nxml-mode) - -(defconst nxml-unicode-blocks - '(("Basic Latin" #x0000 #x007F) - ("Latin-1 Supplement" #x0080 #x00FF) - ("Latin Extended-A" #x0100 #x017F) - ("Latin Extended-B" #x0180 #x024F) - ("IPA Extensions" #x0250 #x02AF) - ("Spacing Modifier Letters" #x02B0 #x02FF) - ("Combining Diacritical Marks" #x0300 #x036F) - ("Greek and Coptic" #x0370 #x03FF) - ("Cyrillic" #x0400 #x04FF) - ("Cyrillic Supplementary" #x0500 #x052F) - ("Armenian" #x0530 #x058F) - ("Hebrew" #x0590 #x05FF) - ("Arabic" #x0600 #x06FF) - ("Syriac" #x0700 #x074F) - ("Thaana" #x0780 #x07BF) - ("Devanagari" #x0900 #x097F) - ("Bengali" #x0980 #x09FF) - ("Gurmukhi" #x0A00 #x0A7F) - ("Gujarati" #x0A80 #x0AFF) - ("Oriya" #x0B00 #x0B7F) - ("Tamil" #x0B80 #x0BFF) - ("Telugu" #x0C00 #x0C7F) - ("Kannada" #x0C80 #x0CFF) - ("Malayalam" #x0D00 #x0D7F) - ("Sinhala" #x0D80 #x0DFF) - ("Thai" #x0E00 #x0E7F) - ("Lao" #x0E80 #x0EFF) - ("Tibetan" #x0F00 #x0FFF) - ("Myanmar" #x1000 #x109F) - ("Georgian" #x10A0 #x10FF) - ("Hangul Jamo" #x1100 #x11FF) - ("Ethiopic" #x1200 #x137F) - ("Cherokee" #x13A0 #x13FF) - ("Unified Canadian Aboriginal Syllabics" #x1400 #x167F) - ("Ogham" #x1680 #x169F) - ("Runic" #x16A0 #x16FF) - ("Tagalog" #x1700 #x171F) - ("Hanunoo" #x1720 #x173F) - ("Buhid" #x1740 #x175F) - ("Tagbanwa" #x1760 #x177F) - ("Khmer" #x1780 #x17FF) - ("Mongolian" #x1800 #x18AF) - ("Latin Extended Additional" #x1E00 #x1EFF) - ("Greek Extended" #x1F00 #x1FFF) - ("General Punctuation" #x2000 #x206F) - ("Superscripts and Subscripts" #x2070 #x209F) - ("Currency Symbols" #x20A0 #x20CF) - ("Combining Diacritical Marks for Symbols" #x20D0 #x20FF) - ("Letterlike Symbols" #x2100 #x214F) - ("Number Forms" #x2150 #x218F) - ("Arrows" #x2190 #x21FF) - ("Mathematical Operators" #x2200 #x22FF) - ("Miscellaneous Technical" #x2300 #x23FF) - ("Control Pictures" #x2400 #x243F) - ("Optical Character Recognition" #x2440 #x245F) - ("Enclosed Alphanumerics" #x2460 #x24FF) - ("Box Drawing" #x2500 #x257F) - ("Block Elements" #x2580 #x259F) - ("Geometric Shapes" #x25A0 #x25FF) - ("Miscellaneous Symbols" #x2600 #x26FF) - ("Dingbats" #x2700 #x27BF) - ("Miscellaneous Mathematical Symbols-A" #x27C0 #x27EF) - ("Supplemental Arrows-A" #x27F0 #x27FF) - ("Braille Patterns" #x2800 #x28FF) - ("Supplemental Arrows-B" #x2900 #x297F) - ("Miscellaneous Mathematical Symbols-B" #x2980 #x29FF) - ("Supplemental Mathematical Operators" #x2A00 #x2AFF) - ("CJK Radicals Supplement" #x2E80 #x2EFF) - ("Kangxi Radicals" #x2F00 #x2FDF) - ("Ideographic Description Characters" #x2FF0 #x2FFF) - ("CJK Symbols and Punctuation" #x3000 #x303F) - ("Hiragana" #x3040 #x309F) - ("Katakana" #x30A0 #x30FF) - ("Bopomofo" #x3100 #x312F) - ("Hangul Compatibility Jamo" #x3130 #x318F) - ("Kanbun" #x3190 #x319F) - ("Bopomofo Extended" #x31A0 #x31BF) - ("Katakana Phonetic Extensions" #x31F0 #x31FF) - ("Enclosed CJK Letters and Months" #x3200 #x32FF) - ("CJK Compatibility" #x3300 #x33FF) - ("CJK Unified Ideographs Extension A" #x3400 #x4DBF) - ;;("CJK Unified Ideographs" #x4E00 #x9FFF) - ("Yi Syllables" #xA000 #xA48F) - ("Yi Radicals" #xA490 #xA4CF) - ;;("Hangul Syllables" #xAC00 #xD7AF) - ;;("High Surrogates" #xD800 #xDB7F) - ;;("High Private Use Surrogates" #xDB80 #xDBFF) - ;;("Low Surrogates" #xDC00 #xDFFF) - ;;("Private Use Area" #xE000 #xF8FF) - ;;("CJK Compatibility Ideographs" #xF900 #xFAFF) - ("Alphabetic Presentation Forms" #xFB00 #xFB4F) - ("Arabic Presentation Forms-A" #xFB50 #xFDFF) - ("Variation Selectors" #xFE00 #xFE0F) - ("Combining Half Marks" #xFE20 #xFE2F) - ("CJK Compatibility Forms" #xFE30 #xFE4F) - ("Small Form Variants" #xFE50 #xFE6F) - ("Arabic Presentation Forms-B" #xFE70 #xFEFF) - ("Halfwidth and Fullwidth Forms" #xFF00 #xFFEF) - ("Specials" #xFFF0 #xFFFF) - ("Old Italic" #x10300 #x1032F) - ("Gothic" #x10330 #x1034F) - ("Deseret" #x10400 #x1044F) - ("Byzantine Musical Symbols" #x1D000 #x1D0FF) - ("Musical Symbols" #x1D100 #x1D1FF) - ("Mathematical Alphanumeric Symbols" #x1D400 #x1D7FF) - ;;("CJK Unified Ideographs Extension B" #x20000 #x2A6DF) - ;;("CJK Compatibility Ideographs Supplement" #x2F800 #x2FA1F) - ("Tags" #xE0000 #xE007F) - ;;("Supplementary Private Use Area-A" #xF0000 #xFFFFF) - ;;("Supplementary Private Use Area-B" #x100000 #x10FFFF) - ) - "List of Unicode blocks. -For each block there is a list (NAME FIRST LAST), where -NAME is a string giving the official name of the block, -FIRST is the first code-point and LAST is the last code-point. -Blocks containing only characters with algorithmic names or no names -are omitted.") - -(defun nxml-unicode-block-char-name-set (name) - "Return a symbol for a block whose official Unicode name is NAME. -The symbol is generated by downcasing and replacing each space -by a hyphen." - (intern (replace-regexp-in-string " " "-" (downcase name)))) - -;; This is intended to be a superset of the coverage -;; of existing standard entity sets. -(defvar nxml-enabled-unicode-blocks-default - '(basic-latin - latin-1-supplement - latin-extended-a - latin-extended-b - ipa-extensions - spacing-modifier-letters - combining-diacritical-marks - greek-and-coptic - cyrillic - general-punctuation - superscripts-and-subscripts - currency-symbols - combining-diacritical-marks-for-symbols - letterlike-symbols - number-forms - arrows - mathematical-operators - miscellaneous-technical - control-pictures - optical-character-recognition - enclosed-alphanumerics - box-drawing - block-elements - geometric-shapes - miscellaneous-symbols - dingbats - miscellaneous-mathematical-symbols-a - supplemental-arrows-a - supplemental-arrows-b - miscellaneous-mathematical-symbols-b - supplemental-mathematical-operators - cjk-symbols-and-punctuation - alphabetic-presentation-forms - variation-selectors - small-form-variants - specials - mathematical-alphanumeric-symbols) - "Default value for `nxml-enabled-unicode-blocks'.") - -(mapc (lambda (block) - (nxml-autoload-char-name-set - (nxml-unicode-block-char-name-set (car block)) - (expand-file-name - (format "nxml/%05X-%05X" - (nth 1 block) - (nth 2 block)) - data-directory))) - nxml-unicode-blocks) - -;; Internal flag to control whether customize reloads the character tables. -;; Should be set the first time the -(defvar nxml-internal-unicode-char-name-sets-enabled nil) - -(defcustom nxml-enabled-unicode-blocks nxml-enabled-unicode-blocks-default - "List of Unicode blocks for which Unicode character names are enabled. -Each block is identified by a symbol derived from the name -of the block by downcasing and replacing each space by a hyphen." - :group 'nxml - :set (lambda (sym value) - (set-default 'nxml-enabled-unicode-blocks value) - (when nxml-internal-unicode-char-name-sets-enabled - (nxml-enable-unicode-char-name-sets))) - :type (cons 'set - (mapcar (lambda (block) - `(const :tag ,(format "%s (%04X-%04X)" - (nth 0 block) - (nth 1 block) - (nth 2 block)) - ,(nxml-unicode-block-char-name-set - (nth 0 block)))) - nxml-unicode-blocks))) - -;;;###autoload -(defun nxml-enable-unicode-char-name-sets () - "Enable the use of Unicode standard names for characters. -The Unicode blocks for which names are enabled is controlled by -the variable `nxml-enabled-unicode-blocks'." - (interactive) - (setq nxml-internal-unicode-char-name-sets-enabled t) - (mapc (lambda (block) - (nxml-disable-char-name-set - (nxml-unicode-block-char-name-set (car block)))) - nxml-unicode-blocks) - (mapc (lambda (nameset) - (nxml-enable-char-name-set nameset)) - nxml-enabled-unicode-blocks)) - -(provide 'nxml-uchnm) - -;;; 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 @@ -;;; awk-mode.el --- AWK code editing commands for Emacs - -;; Copyright (C) 1988, 1994, 1996, 2000-2017 Free Software Foundation, -;; Inc. - -;; Maintainer: emacs-devel@gnu.org -;; Keywords: unix, languages -;; Obsolete-since: 22.1 - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Sets up C-mode with support for awk-style #-comments and a lightly -;; hacked syntax table. - -;;; Code: - -(defvar awk-mode-syntax-table - (let ((st (make-syntax-table))) - (modify-syntax-entry ?\\ "\\" st) - (modify-syntax-entry ?\n "> " st) - (modify-syntax-entry ?\f "> " st) - (modify-syntax-entry ?\# "< " st) - ;; / can delimit regexes or be a division operator. We assume that it is - ;; more commonly used for regexes and fix the remaining cases with - ;; `font-lock-syntactic-keywords'. - (modify-syntax-entry ?/ "\"" st) - (modify-syntax-entry ?* "." st) - (modify-syntax-entry ?+ "." st) - (modify-syntax-entry ?- "." st) - (modify-syntax-entry ?= "." st) - (modify-syntax-entry ?% "." st) - (modify-syntax-entry ?< "." st) - (modify-syntax-entry ?> "." st) - (modify-syntax-entry ?& "." st) - (modify-syntax-entry ?| "." st) - (modify-syntax-entry ?_ "_" st) - (modify-syntax-entry ?\' "\"" st) - st) - "Syntax table in use in `awk-mode' buffers.") - -;; Regexps written with help from Peter Galbraith <galbraith@mixing.qc.dfo.ca>. -(defconst awk-font-lock-keywords - (eval-when-compile - (list - ;; - ;; Function names. - '("^[ \t]*\\(function\\)\\>[ \t]*\\(\\sw+\\)?" - (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)) - ;; - ;; Variable names. - (cons (regexp-opt - '("ARGC" "ARGIND" "ARGV" "CONVFMT" "ENVIRON" "ERRNO" - "FIELDWIDTHS" "FILENAME" "FNR" "FS" "IGNORECASE" "NF" "NR" - "OFMT" "OFS" "ORS" "RLENGTH" "RS" "RSTART" "SUBSEP") 'words) - 'font-lock-variable-name-face) - ;; - ;; Keywords. - (regexp-opt - '("BEGIN" "END" "break" "continue" "delete" "do" "exit" "else" "for" - "getline" "if" "next" "print" "printf" "return" "while") 'words) - ;; - ;; Builtins. - (list (regexp-opt - '("atan2" "close" "cos" "ctime" "exp" "gsub" "index" "int" - "length" "log" "match" "rand" "sin" "split" "sprintf" - "sqrt" "srand" "sub" "substr" "system" "time" - "tolower" "toupper") 'words) - 1 'font-lock-builtin-face) - ;; - ;; Operators. Is this too much? - (cons (regexp-opt '("&&" "||" "<=" "<" ">=" ">" "==" "!=" "!~" "~")) - 'font-lock-constant-face) - )) - "Default expressions to highlight in AWK mode.") - -(require 'syntax) - -(defconst awk-font-lock-syntactic-keywords - ;; `/' is mostly used for /.../ regular expressions, but is also - ;; used as a division operator. Distinguishing between the two is - ;; a pain in the youknowwhat. - ;; '(("\\(^\\|[<=>-+*%/!^,~(?:|&]\\)\\s-*\\(/\\)\\([^/\n\\]\\|\\\\.\\)*\\(/\\)" - ;; (2 "\"") (4 "\""))) - '(("[^<=>-+*%/!^,~(?:|& \t\n\f]\\s-*\\(/\\)" - (1 (unless (nth 3 (syntax-ppss (match-beginning 1))) ".")))) - "Syntactic keywords for `awk-mode'.") - -;; No longer autoloaded since it might clobber the autoload directive in CC Mode. -(define-derived-mode awk-mode c-mode "AWK" - "Major mode for editing AWK code. -This is much like C mode except for the syntax of comments. Its keymap -inherits from C mode's and it has the same variables for customizing -indentation. It has its own abbrev table and its own syntax table. - -Turning on AWK mode runs `awk-mode-hook'." - (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter)) - (set (make-local-variable 'paragraph-separate) paragraph-start) - (set (make-local-variable 'comment-start) "# ") - (set (make-local-variable 'comment-end) "") - (set (make-local-variable 'comment-start-skip) "#+ *") - (setq font-lock-defaults '(awk-font-lock-keywords - nil nil ((?_ . "w")) nil - (parse-sexp-lookup-properties . t) - (font-lock-syntactic-keywords - . awk-font-lock-syntactic-keywords)))) - -(provide 'awk-mode) - -;;; 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 @@ -;;; iso-acc.el --- minor mode providing electric accent keys - -;; Copyright (C) 1993-1994, 1996, 2001-2017 Free Software Foundation, -;; Inc. - -;; Author: Johan Vromans -;; Maintainer: emacs-devel@gnu.org -;; Keywords: i18n -;; Obsolete-since: 22.1 - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Function `iso-accents-mode' activates a minor mode in which -;; typewriter "dead keys" are emulated. The purpose of this emulation -;; is to provide a simple means for inserting accented characters -;; according to the ISO-8859-1...3 character sets. -;; -;; In `iso-accents-mode', pseudo accent characters are used to -;; introduce accented keys. The pseudo-accent characters are: -;; -;; ' (minute) -> acute accent -;; ` (backtick) -> grave accent -;; " (second) -> diaeresis -;; ^ (caret) -> circumflex -;; ~ (tilde) -> tilde over the character -;; / (slash) -> slash through the character. -;; Also: /A is A-with-ring and /E is AE ligature. -;; These two are enabled only if you set iso-accents-enable -;; to include them: -;; . (period) -> dot over the character (some languages only) -;; , (cedilla) -> cedilla under the character (some languages only) -;; -;; The action taken depends on the key that follows the pseudo accent. -;; In general: -;; -;; pseudo-accent + appropriate letter -> accented letter -;; pseudo-accent + space -> pseudo-accent (except comma and period) -;; pseudo-accent + pseudo-accent -> accent (if available) -;; pseudo-accent + other -> pseudo-accent + other -;; -;; If the pseudo-accent is followed by anything else than a -;; self-insert-command, the dead-key code is terminated, the -;; pseudo-accent inserted ‘as is’ and the bell is rung to signal this. -;; -;; Function `iso-accents-mode' can be used to enable the iso accents -;; minor mode, or disable it. - -;; If you want only some of these characters to serve as accents, -;; add a language to `iso-languages' which specifies the accent characters -;; that you want, then select the language with `iso-accents-customize'. - -;;; Code: - -(provide 'iso-acc) - -(defgroup iso-acc nil - "Minor mode providing electric accent keys." - :prefix "iso-accents-" - :group 'i18n) - -(defcustom iso-accents-insert-offset nonascii-insert-offset - "Offset added by ISO Accents mode to character codes 0200 and above." - :type 'integer - :group 'iso-acc) - -(defvar iso-languages - '(("catalan" - ;; Note this includes some extra characters used in Spanish, - ;; on the idea that someone who uses Catalan is likely to use Spanish - ;; as well. - (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) - (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372) - (?\ . ?')) - (?` (?A . ?\300) (?E . ?\310) (?O . ?\322) - (?a . ?\340) (?e . ?\350) (?o . ?\362) - (?\ . ?`)) - (?\" (?I . ?\317) (?U . ?\334) (?i . ?\357) (?u . ?\374) - (?\ . ?\")) - (?~ (?C . ?\307) (?N . ?\321) (?c . ?\347) (?n . ?\361) - (?> . ?\273) (?< . ?\253) (?! . ?\241) (?? . ?\277) - (?\ . ?\~))) - - ("esperanto" - (?^ (?H . ?\246) (?J . ?\254) (?h . ?\266) (?j . ?\274) (?C . ?\306) - (?G . ?\330) (?S . ?\336) (?c . ?\346) (?g . ?\370) (?s . ?\376) - (?^ . ?^) (?\ . ?^)) - (?~ (?U . ?\335) (?u . ?\375) (?\ . ?~))) - - ("french" - (?' (?E . ?\311) (?C . ?\307) (?e . ?\351) (?c . ?\347) - (?\ . ?')) - (?` (?A . ?\300) (?E . ?\310) (?U . ?\331) - (?a . ?\340) (?e . ?\350) (?u . ?\371) - (?\ . ?`)) - (?^ (?A . ?\302) (?E . ?\312) (?I . ?\316) (?O . ?\324) (?U . ?\333) - (?a . ?\342) (?e . ?\352) (?i . ?\356) (?o . ?\364) (?u . ?\373) - (?\ . ?^)) - (?\" (?E . ?\313) (?I . ?\317) - (?e . ?\353) (?i . ?\357) - (?\ . ?\")) - (?~ (?< . ?\253) (?> . ?\273) (?C . ?\307) (?c . ?\347) - (?\ . ?~)) - (?, (?C . ?\307) (?c . ?\347) (?\ . ?\,))) - - ("german" - (?\" (?A . ?\304) (?O . ?\326) (?U . ?\334) - (?a . ?\344) (?o . ?\366) (?u . ?\374) (?s . ?\337) (?\ . ?\"))) - - ("irish" - (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) - (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372) - (?\ . ?'))) - - ("portuguese" - (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) - (?C . ?\307) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) - (?u . ?\372) (?c . ?\347) - (?\ . ?')) - (?` (?A . ?\300) (?a . ?\340) - (?\ . ?`)) - (?^ (?A . ?\302) (?E . ?\312) (?O . ?\324) - (?a . ?\342) (?e . ?\352) (?o . ?\364) - (?\ . ?^)) - (?\" (?U . ?\334) (?u . ?\374) - (?\ . ?\")) - (?~ (?A . ?\303) (?O . ?\325) (?a . ?\343) (?o . ?\365) - (?C . ?\307) (?N . ?\321) (?c . ?\347) (?n . ?\361) - (?\ . ?~)) - (?, (?c . ?\347) (?C . ?\307) (?, . ?,))) - - ("spanish" - (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) - (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372) - (?\ . ?')) - (?\" (?U . ?\334) (?u . ?\374) (?\ . ?\")) - (?\~ (?N . ?\321) (?n . ?\361) (?> . ?\273) (?< . ?\253) (?! . ?\241) - (?? . ?\277) (?\ . ?\~))) - - ("latin-1" - (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) - (?Y . ?\335) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) - (?u . ?\372) (?y . ?\375) (?' . ?\264) - (?\ . ?')) - (?` (?A . ?\300) (?E . ?\310) (?I . ?\314) (?O . ?\322) (?U . ?\331) - (?a . ?\340) (?e . ?\350) (?i . ?\354) (?o . ?\362) (?u . ?\371) - (?` . ?`) (?\ . ?`)) - (?^ (?A . ?\302) (?E . ?\312) (?I . ?\316) (?O . ?\324) (?U . ?\333) - (?a . ?\342) (?e . ?\352) (?i . ?\356) (?o . ?\364) (?u . ?\373) - (?^ . ?^) (?\ . ?^)) - (?\" (?A . ?\304) (?E . ?\313) (?I . ?\317) (?O . ?\326) (?U . ?\334) - (?a . ?\344) (?e . ?\353) (?i . ?\357) (?o . ?\366) (?s . ?\337) - (?u . ?\374) (?y . ?\377) - (?\" . ?\250) (?\ . ?\")) - (?~ (?A . ?\303) (?C . ?\307) (?D . ?\320) (?N . ?\321) (?O . ?\325) - (?T . ?\336) (?a . ?\343) (?c . ?\347) (?d . ?\360) (?n . ?\361) - (?o . ?\365) (?t . ?\376) - (?> . ?\273) (?< . ?\253) (?! . ?\241) (?? . ?\277) - (?\~ . ?\270) (?\ . ?~)) - (?/ (?A . ?\305) (?E . ?\306) (?O . ?\330) (?a . ?\345) (?e . ?\346) - (?o . ?\370) - (?/ . ?\260) (?\ . ?/))) - - ("latin-2" latin-iso8859-2 - (?' (?A . ?\301) (?C . ?\306) (?D . ?\320) (?E . ?\311) (?I . ?\315) - (?L . ?\305) (?N . ?\321) (?O . ?\323) (?R . ?\300) (?S . ?\246) - (?U . ?\332) (?Y . ?\335) (?Z . ?\254) - (?a . ?\341) (?c . ?\346) (?d . ?\360) (?e . ?\351) (?i . ?\355) - (?l . ?\345) (?n . ?\361) (?o . ?\363) (?r . ?\340) (?s . ?\266) - (?u . ?\372) (?y . ?\375) (?z . ?\274) - (?' . ?\264) (?\ . ?')) - (?` (?A . ?\241) (?C . ?\307) (?E . ?\312) (?L . ?\243) (?S . ?\252) - (?T . ?\336) (?Z . ?\257) - (?a . ?\261) (?l . ?\263) (?c . ?\347) (?e . ?\352) (?s . ?\272) - (?t . ?\376) (?z . ?\277) - (?` . ?\252) - (?. . ?\377) (?\ . ?`)) - (?^ (?A . ?\302) (?I . ?\316) (?O . ?\324) - (?a . ?\342) (?i . ?\356) (?o . ?\364) - (?^ . ?^) ; no special code? - (?\ . ?^)) - (?\" (?A . ?\304) (?E . ?\313) (?O . ?\326) (?U . ?\334) - (?a . ?\344) (?e . ?\353) (?o . ?\366) (?s . ?\337) (?u . ?\374) - (?\" . ?\250) - (?\ . ?\")) - (?~ (?A . ?\303) (?C . ?\310) (?D . ?\317) (?L . ?\245) (?N . ?\322) - (?O . ?\325) (?R . ?\330) (?S . ?\251) (?T . ?\253) (?U . ?\333) - (?Z . ?\256) - (?a . ?\343) (?c . ?\350) (?d . ?\357) (?l . ?\265) (?n . ?\362) - (?o . ?\365) (?r . ?\370) (?s . ?\271) (?t . ?\273) (?u . ?\373) - (?z . ?\276) - (?v . ?\242) ; v accent - (?\~ . ?\242) ; v accent - (?\. . ?\270) ; cedilla accent - (?\ . ?~))) - - ("latin-3" latin-iso8859-3 - (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) - (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372) - (?' . ?\264) (?\ . ?')) - (?` (?A . ?\300) (?E . ?\310) (?I . ?\314) (?O . ?\322) (?U . ?\331) - (?a . ?\340) (?e . ?\350) (?i . ?\354) (?o . ?\362) (?u . ?\371) - (?` . ?`) (?\ . ?`)) - (?^ (?A . ?\302) (?C . ?\306) (?E . ?\312) (?G . ?\330) (?H . ?\246) - (?I . ?\316) (?J . ?\254) (?O . ?\324) (?S . ?\336) (?U . ?\333) - (?a . ?\342) (?c . ?\346) (?e . ?\352) (?g . ?\370) (?h . ?\266) - (?i . ?\356) (?j . ?\274) (?o . ?\364) (?s . ?\376) (?u . ?\373) - (?^ . ?^) (?\ . ?^)) - (?\" (?A . ?\304) (?E . ?\313) (?I . ?\317) (?O . ?\326) (?U . ?\334) - (?a . ?\344) (?e . ?\353) (?i . ?\357) (?o . ?\366) (?u . ?\374) - (?s . ?\337) - (?\" . ?\250) (?\ . ?\")) - (?~ (?A . ?\303) (?C . ?\307) (?D . ?\320) (?N . ?\321) (?O . ?\325) - (?a . ?\343) (?c . ?\347) (?d . ?\360) (?n . ?\361) (?o . ?\365) - (?$ . ?\245) (?S . ?\252) (?s . ?\272) (?G . ?\253) (?g . ?\273) - (?U . ?\335) (?u . ?\375) (?` . ?\242) - (?~ . ?\270) (?\ . ?~)) - (?/ (?C . ?\305) (?G . ?\325) (?H . ?\241) (?I . ?\251) (?Z . ?\257) - (?c . ?\345) (?g . ?\365) (?h . ?\261) (?i . ?\271) (?z . ?\277) - (?r . ?\256) - (?. . ?\377) (?# . ?\243) (?$ . ?\244) - (?/ . ?\260) (?\ . ?/)) - (?. (?C . ?\305) (?G . ?\325) (?I . ?\251) (?Z . ?\257) - (?c . ?\345) (?g . ?\365) (?z . ?\277)))) - "List of language-specific customizations for the ISO Accents mode. - -Each element of the list is of the form - - (LANGUAGE [CHARSET] - (PSEUDO-ACCENT MAPPINGS) - (PSEUDO-ACCENT MAPPINGS) - ...) - -LANGUAGE is a string naming the language. -CHARSET (which may be omitted) is the symbol name - of the character set used in this language. - If CHARSET is omitted, latin-iso8859-1 is the default. -PSEUDO-ACCENT is a char specifying an accent key. -MAPPINGS are cons cells of the form (CHAR . ISO-CHAR). - -The net effect is that the key sequence PSEUDO-ACCENT CHAR is mapped -to ISO-CHAR on input.") - -(defvar iso-language nil - "Language for which ISO Accents mode is currently customized. -Change it with the `iso-accents-customize' function.") - -(defvar iso-accents-list nil - "Association list for ISO accent combinations, for the chosen language.") - -(defcustom iso-accents-mode nil - "Non-nil enables ISO Accents mode. -Setting this variable makes it local to the current buffer. -See the function `iso-accents-mode'." - :type 'boolean - :group 'iso-acc) -(make-variable-buffer-local 'iso-accents-mode) - -(defcustom iso-accents-enable '(?' ?` ?^ ?\" ?~ ?/) - "List of accent keys that become prefixes in ISO Accents mode. -The default is (?\\=' ?\\=` ?^ ?\" ?~ ?/), which contains all the supported -accent keys. If you set this variable to a list in which some of those -characters are missing, the missing ones do not act as accents. - -Note that if you specify a language with `iso-accents-customize', -that can also turn off certain prefixes (whichever ones are not needed in -the language you choose)." - :type '(repeat character) - :group 'iso-acc) - -(defun iso-accents-accent-key (prompt) - "Modify the following character by adding an accent to it." - ;; Pick up the accent character. - (if (and iso-accents-mode - (memq last-input-event iso-accents-enable)) - (iso-accents-compose prompt) - (vector last-input-event))) - - -;; The iso-accents-compose function is called deep inside Emacs' read -;; key sequence machinery, so the call to read-event below actually -;; recurses into that machinery. Doing that does not cause any -;; problem on its own, but read-event will have marked the window's -;; display matrix to be accurate -- which is broken by the subsequent -;; call to delete-region. Therefore, we must call force-window-update -;; after delete-region to explicitly clear the accurate state of the -;; window's display matrix. - -(defun iso-accents-compose (prompt) - (let* ((first-char last-input-event) - (list (assq first-char iso-accents-list)) - ;; Wait for the second key and look up the combination. - (second-char (if (or prompt - (not (eq (key-binding "a") - 'self-insert-command)) - ;; Not at start of a key sequence. - (> (length (this-single-command-keys)) 1) - ;; Called from anything but the command loop. - this-command) - (progn - (message "%s%c" - (or prompt "Compose with ") - first-char) - (read-event)) - (insert first-char) - (prog1 (read-event) - (delete-region (1- (point)) (point)) - ;; Display is no longer up-to-date. - (force-window-update (selected-window))))) - (entry (cdr (assq second-char list)))) - (if entry - ;; Found it: return the mapped char - (vector - (if (and enable-multibyte-characters - (>= entry ?\200)) - (+ iso-accents-insert-offset entry) - entry)) - ;; Otherwise, advance and schedule the second key for execution. - (push second-char unread-command-events) - (vector first-char)))) - -;; It is a matter of taste if you want the minor mode indicated -;; in the mode line... -;; If so, uncomment the next four lines. -;; (or (assq 'iso-accents-mode minor-mode-alist) -;; (setq minor-mode-alist -;; (append minor-mode-alist -;; '((iso-accents-mode " ISO-Acc"))))) - -;;;###autoload -(defun iso-accents-mode (&optional arg) - "Toggle ISO Accents mode, in which accents modify the following letter. -This permits easy insertion of accented characters according to ISO-8859-1. -When Iso-accents mode is enabled, accent character keys -\(\\=`, \\=', \", ^, / and ~) do not self-insert; instead, they modify the following -letter key so that it inserts an ISO accented letter. - -You can customize ISO Accents mode to a particular language -with the command `iso-accents-customize'. - -Special combinations: ~c gives a c with cedilla, -~d gives an Icelandic eth (d with dash). -~t gives an Icelandic thorn. -\"s gives German sharp s. -/a gives a with ring. -/e gives an a-e ligature. -~< and ~> give guillemots. -~! gives an inverted exclamation mark. -~? gives an inverted question mark. - -With an argument, a positive argument enables ISO Accents mode, -and a negative argument disables it." - - (interactive "P") - - (if (if arg - ;; Negative arg means switch it off. - (<= (prefix-numeric-value arg) 0) - ;; No arg means toggle. - iso-accents-mode) - (setq iso-accents-mode nil) - - ;; Enable electric accents. - (setq iso-accents-mode t))) - -(defun iso-accents-customize (language) - "Customize the ISO accents machinery for a particular language. -It selects the customization based on the specifications in the -`iso-languages' variable." - (interactive (list (completing-read "Language: " iso-languages nil t))) - (let ((table (cdr (assoc language iso-languages))) - all-accents tail) - (if (not table) - (error "Unknown language `%s'" language) - (setq iso-accents-insert-offset (- (make-char (if (symbolp (car table)) - (car table) - 'latin-iso8859-1)) - 128)) - (if (symbolp (car table)) - (setq table (cdr table))) - (setq iso-language language - iso-accents-list table) - (if key-translation-map - (substitute-key-definition - 'iso-accents-accent-key nil key-translation-map) - (setq key-translation-map (make-sparse-keymap))) - ;; Set up translations for all the characters that are used as - ;; accent prefixes in this language. - (setq tail iso-accents-list) - (while tail - (define-key key-translation-map (vector (car (car tail))) - 'iso-accents-accent-key) - (setq tail (cdr tail)))))) - -(defun iso-accentuate (start end) - "Convert two-character sequences in region into accented characters. -Noninteractively, this operates on text from START to END. -This uses the same conversion that ISO Accents mode uses for type-in." - (interactive "r") - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char start) - (forward-char 1) - (let (entry) - (while (< (point) end) - (if (and (memq (preceding-char) iso-accents-enable) - (setq entry (cdr (assq (following-char) (assq (preceding-char) iso-accents-list))))) - (progn - (forward-char -1) - (delete-char 2) - (insert entry) - (setq end (1- end))) - (forward-char 1))))))) - -(defun iso-accent-rassoc-unit (value alist) - (let (elt acc) - (while (and alist (not elt)) - (setq acc (car (car alist)) - elt (car (rassq value (cdr (car alist)))) - alist (cdr alist))) - (if elt - (cons acc elt)))) - -(defun iso-unaccentuate (start end) - "Convert accented characters in the region into two-character sequences. -Noninteractively, this operates on text from START to END. -This uses the opposite of the conversion done by ISO Accents mode for type-in." - (interactive "r") - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char start) - (let (entry) - (while (< (point) end) - (if (and (> (following-char) 127) - (setq entry (iso-accent-rassoc-unit (following-char) - iso-accents-list))) - (progn - (delete-char 1) - (insert (car entry) (cdr entry)) - (setq end (1+ end))) - (forward-char 1))))))) - -(defun iso-deaccentuate (start end) - "Convert accented characters in the region into unaccented characters. -Noninteractively, this operates on text from START to END." - (interactive "r") - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char start) - (let (entry) - (while (< (point) end) - (if (and (> (following-char) 127) - (setq entry (iso-accent-rassoc-unit (following-char) - iso-accents-list))) - (progn - (delete-char 1) - (insert (cdr entry))) - (forward-char 1))))))) - -;; Set up the default settings. -(iso-accents-customize "latin-1") - -;; Use Iso-Accents mode in the minibuffer -;; if it was in use in the previous buffer. -(defun iso-acc-minibuf-setup () - (setq iso-accents-mode - (with-current-buffer (window-buffer minibuffer-scroll-window) - iso-accents-mode))) - -(add-hook 'minibuffer-setup-hook 'iso-acc-minibuf-setup) - -;;; 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 @@ -;;; iso-insert.el --- insert functions for ISO 8859/1 - -;; Copyright (C) 1987, 1994, 2001-2017 Free Software Foundation, Inc. - -;; Author: Howard Gayle -;; Maintainer: emacs-devel@gnu.org -;; Keywords: i18n -;; Obsolete-since: 22.1 - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Provides keys for inserting ISO Latin-1 characters. They use the -;; prefix key C-x 8. Type C-x 8 C-h for a list. - -;;; Code: - -(defun insert-no-break-space () - (interactive "*") - (insert ?\ ) -) - -(defun insert-inverted-exclamation-mark () - (interactive "*") - (insert ?\¡) -) - -(defun insert-cent-sign () - (interactive "*") - (insert ?\¢) -) - -(defun insert-pound-sign () - (interactive "*") - (insert ?\£) -) - -(defun insert-general-currency-sign () - (interactive "*") - (insert ?\¤) -) - -(defun insert-yen-sign () - (interactive "*") - (insert ?\¥) -) - -(defun insert-broken-vertical-line () - (interactive "*") - (insert ?\¦) -) - -(defun insert-section-sign () - (interactive "*") - (insert ?\§) -) - -(defun insert-diaeresis () - (interactive "*") - (insert ?\¨) -) - -(defun insert-copyright-sign () - (interactive "*") - (insert ?\©) -) - -(defun insert-ordinal-indicator-feminine () - (interactive "*") - (insert ?\ª) -) - -(defun insert-angle-quotation-mark-left () - (interactive "*") - (insert ?\«) -) - -(defun insert-not-sign () - (interactive "*") - (insert ?\¬) -) - -(defun insert-soft-hyphen () - (interactive "*") - (insert ?\) -) - -(defun insert-registered-sign () - (interactive "*") - (insert ?\®) -) - -(defun insert-macron () - (interactive "*") - (insert ?\¯) -) - -(defun insert-degree-sign () - (interactive "*") - (insert ?\°) -) - -(defun insert-plus-or-minus-sign () - (interactive "*") - (insert ?\±) -) - -(defun insert-superscript-two () - (interactive "*") - (insert ?\²) -) - -(defun insert-superscript-three () - (interactive "*") - (insert ?\³) -) - -(defun insert-acute-accent () - (interactive "*") - (insert ?\´) -) - -(defun insert-micro-sign () - (interactive "*") - (insert ?\µ) -) - -(defun insert-pilcrow () - (interactive "*") - (insert ?\¶) -) - -(defun insert-middle-dot () - (interactive "*") - (insert ?\·) -) - -(defun insert-cedilla () - (interactive "*") - (insert ?\¸) -) - -(defun insert-superscript-one () - (interactive "*") - (insert ?\¹) -) - -(defun insert-ordinal-indicator-masculine () - (interactive "*") - (insert ?\º) -) - -(defun insert-angle-quotation-mark-right () - (interactive "*") - (insert ?\») -) - -(defun insert-fraction-one-quarter () - (interactive "*") - (insert ?\¼) -) - -(defun insert-fraction-one-half () - (interactive "*") - (insert ?\½) -) - -(defun insert-fraction-three-quarters () - (interactive "*") - (insert ?\¾) -) - -(defun insert-inverted-question-mark () - (interactive "*") - (insert ?\¿) -) - -(defun insert-A-grave () - (interactive "*") - (insert ?\À) -) - -(defun insert-A-acute () - (interactive "*") - (insert ?\Á) -) - -(defun insert-A-circumflex () - (interactive "*") - (insert ?\Â) -) - -(defun insert-A-tilde () - (interactive "*") - (insert ?\Ã) -) - -(defun insert-A-umlaut () - (interactive "*") - (insert ?\Ä) -) - -(defun insert-A-ring () - (interactive "*") - (insert ?\Å) -) - -(defun insert-AE () - (interactive "*") - (insert ?\Æ) -) - -(defun insert-C-cedilla () - (interactive "*") - (insert ?\Ç) -) - -(defun insert-E-grave () - (interactive "*") - (insert ?\È) -) - -(defun insert-E-acute () - (interactive "*") - (insert ?\É) -) - -(defun insert-E-circumflex () - (interactive "*") - (insert ?\Ê) -) - -(defun insert-E-umlaut () - (interactive "*") - (insert ?\Ë) -) - -(defun insert-I-grave () - (interactive "*") - (insert ?\Ì) -) - -(defun insert-I-acute () - (interactive "*") - (insert ?\Í) -) - -(defun insert-I-circumflex () - (interactive "*") - (insert ?\Î) -) - -(defun insert-I-umlaut () - (interactive "*") - (insert ?\Ï) -) - -(defun insert-D-stroke () - (interactive "*") - (insert ?\Ð) -) - -(defun insert-N-tilde () - (interactive "*") - (insert ?\Ñ) -) - -(defun insert-O-grave () - (interactive "*") - (insert ?\Ò) -) - -(defun insert-O-acute () - (interactive "*") - (insert ?\Ó) -) - -(defun insert-O-circumflex () - (interactive "*") - (insert ?\Ô) -) - -(defun insert-O-tilde () - (interactive "*") - (insert ?\Õ) -) - -(defun insert-O-umlaut () - (interactive "*") - (insert ?\Ö) -) - -(defun insert-multiplication-sign () - (interactive "*") - (insert ?\×) -) - -(defun insert-O-slash () - (interactive "*") - (insert ?\Ø) -) - -(defun insert-U-grave () - (interactive "*") - (insert ?\Ù) -) - -(defun insert-U-acute () - (interactive "*") - (insert ?\Ú) -) - -(defun insert-U-circumflex () - (interactive "*") - (insert ?\Û) -) - -(defun insert-U-umlaut () - (interactive "*") - (insert ?\Ü) -) - -(defun insert-Y-acute () - (interactive "*") - (insert ?\Ý) -) - -(defun insert-THORN () - (interactive "*") - (insert ?\Þ) -) - -(defun insert-ss () - (interactive "*") - (insert ?\ß) -) - -(defun insert-a-grave () - (interactive "*") - (insert ?\à) -) - -(defun insert-a-acute () - (interactive "*") - (insert ?\á) -) - -(defun insert-a-circumflex () - (interactive "*") - (insert ?\â) -) - -(defun insert-a-tilde () - (interactive "*") - (insert ?\ã) -) - -(defun insert-a-umlaut () - (interactive "*") - (insert ?\ä) -) - -(defun insert-a-ring () - (interactive "*") - (insert ?\å) -) - -(defun insert-ae () - (interactive "*") - (insert ?\æ) -) - -(defun insert-c-cedilla () - (interactive "*") - (insert ?\ç) -) - -(defun insert-e-grave () - (interactive "*") - (insert ?\è) -) - -(defun insert-e-acute () - (interactive "*") - (insert ?\é) -) - -(defun insert-e-circumflex () - (interactive "*") - (insert ?\ê) -) - -(defun insert-e-umlaut () - (interactive "*") - (insert ?\ë) -) - -(defun insert-i-grave () - (interactive "*") - (insert ?\ì) -) - -(defun insert-i-acute () - (interactive "*") - (insert ?\í) -) - -(defun insert-i-circumflex () - (interactive "*") - (insert ?\î) -) - -(defun insert-i-umlaut () - (interactive "*") - (insert ?\ï) -) - -(defun insert-d-stroke () - (interactive "*") - (insert ?\ð) -) - -(defun insert-n-tilde () - (interactive "*") - (insert ?\ñ) -) - -(defun insert-o-grave () - (interactive "*") - (insert ?\ò) -) - -(defun insert-o-acute () - (interactive "*") - (insert ?\ó) -) - -(defun insert-o-circumflex () - (interactive "*") - (insert ?\ô) -) - -(defun insert-o-tilde () - (interactive "*") - (insert ?\õ) -) - -(defun insert-o-umlaut () - (interactive "*") - (insert ?\ö) -) - -(defun insert-division-sign () - (interactive "*") - (insert ?\÷) -) - -(defun insert-o-slash () - (interactive "*") - (insert ?\ø) -) - -(defun insert-u-grave () - (interactive "*") - (insert ?\ù) -) - -(defun insert-u-acute () - (interactive "*") - (insert ?\ú) -) - -(defun insert-u-circumflex () - (interactive "*") - (insert ?\û) -) - -(defun insert-u-umlaut () - (interactive "*") - (insert ?\ü) -) - -(defun insert-y-acute () - (interactive "*") - (insert ?\ý) -) - -(defun insert-thorn () - (interactive "*") - (insert ?\þ) -) - -(defun insert-y-umlaut () - (interactive "*") - (insert ?\ÿ) -) - -(defvar 8859-1-map nil "Keymap for ISO 8859/1 character insertion.") -(if 8859-1-map nil - (setq 8859-1-map (make-keymap)) - (define-key 8859-1-map " " 'insert-no-break-space) - (define-key 8859-1-map "!" 'insert-inverted-exclamation-mark) - (define-key 8859-1-map "\"" (make-sparse-keymap)) - (define-key 8859-1-map "\"\"" 'insert-diaeresis) - (define-key 8859-1-map "\"A" 'insert-A-umlaut) - (define-key 8859-1-map "\"E" 'insert-E-umlaut) - (define-key 8859-1-map "\"I" 'insert-I-umlaut) - (define-key 8859-1-map "\"O" 'insert-O-umlaut) - (define-key 8859-1-map "\"U" 'insert-U-umlaut) - (define-key 8859-1-map "\"a" 'insert-a-umlaut) - (define-key 8859-1-map "\"e" 'insert-e-umlaut) - (define-key 8859-1-map "\"i" 'insert-i-umlaut) - (define-key 8859-1-map "\"o" 'insert-o-umlaut) - (define-key 8859-1-map "\"u" 'insert-u-umlaut) - (define-key 8859-1-map "\"y" 'insert-y-umlaut) - (define-key 8859-1-map "'" (make-sparse-keymap)) - (define-key 8859-1-map "''" 'insert-acute-accent) - (define-key 8859-1-map "'A" 'insert-A-acute) - (define-key 8859-1-map "'E" 'insert-E-acute) - (define-key 8859-1-map "'I" 'insert-I-acute) - (define-key 8859-1-map "'O" 'insert-O-acute) - (define-key 8859-1-map "'U" 'insert-U-acute) - (define-key 8859-1-map "'Y" 'insert-Y-acute) - (define-key 8859-1-map "'a" 'insert-a-acute) - (define-key 8859-1-map "'e" 'insert-e-acute) - (define-key 8859-1-map "'i" 'insert-i-acute) - (define-key 8859-1-map "'o" 'insert-o-acute) - (define-key 8859-1-map "'u" 'insert-u-acute) - (define-key 8859-1-map "'y" 'insert-y-acute) - (define-key 8859-1-map "$" 'insert-general-currency-sign) - (define-key 8859-1-map "+" 'insert-plus-or-minus-sign) - (define-key 8859-1-map "," (make-sparse-keymap)) - (define-key 8859-1-map ",," 'insert-cedilla) - (define-key 8859-1-map ",C" 'insert-C-cedilla) - (define-key 8859-1-map ",c" 'insert-c-cedilla) - (define-key 8859-1-map "-" 'insert-soft-hyphen) - (define-key 8859-1-map "." 'insert-middle-dot) - (define-key 8859-1-map "/" (make-sparse-keymap)) - (define-key 8859-1-map "//" 'insert-division-sign) - (define-key 8859-1-map "/O" 'insert-O-slash) - (define-key 8859-1-map "/o" 'insert-o-slash) - (define-key 8859-1-map "1" (make-sparse-keymap)) - (define-key 8859-1-map "1/" (make-sparse-keymap)) - (define-key 8859-1-map "1/2" 'insert-fraction-one-half) - (define-key 8859-1-map "1/4" 'insert-fraction-one-quarter) - (define-key 8859-1-map "3" (make-sparse-keymap)) - (define-key 8859-1-map "3/" (make-sparse-keymap)) - (define-key 8859-1-map "3/4" 'insert-fraction-three-quarters) - (define-key 8859-1-map "<" 'insert-angle-quotation-mark-left) - (define-key 8859-1-map "=" 'insert-macron) - (define-key 8859-1-map ">" 'insert-angle-quotation-mark-right) - (define-key 8859-1-map "?" 'insert-inverted-question-mark) - (define-key 8859-1-map "A" 'insert-A-ring) - (define-key 8859-1-map "E" 'insert-AE) - (define-key 8859-1-map "C" 'insert-copyright-sign) - (define-key 8859-1-map "D" 'insert-D-stroke) - (define-key 8859-1-map "L" 'insert-pound-sign) - (define-key 8859-1-map "P" 'insert-pilcrow) - (define-key 8859-1-map "R" 'insert-registered-sign) - (define-key 8859-1-map "S" 'insert-section-sign) - (define-key 8859-1-map "T" 'insert-THORN) - (define-key 8859-1-map "Y" 'insert-yen-sign) - (define-key 8859-1-map "^" (make-sparse-keymap)) - (define-key 8859-1-map "^1" 'insert-superscript-one) - (define-key 8859-1-map "^2" 'insert-superscript-two) - (define-key 8859-1-map "^3" 'insert-superscript-three) - (define-key 8859-1-map "^A" 'insert-A-circumflex) - (define-key 8859-1-map "^E" 'insert-E-circumflex) - (define-key 8859-1-map "^I" 'insert-I-circumflex) - (define-key 8859-1-map "^O" 'insert-O-circumflex) - (define-key 8859-1-map "^U" 'insert-U-circumflex) - (define-key 8859-1-map "^a" 'insert-a-circumflex) - (define-key 8859-1-map "^e" 'insert-e-circumflex) - (define-key 8859-1-map "^i" 'insert-i-circumflex) - (define-key 8859-1-map "^o" 'insert-o-circumflex) - (define-key 8859-1-map "^u" 'insert-u-circumflex) - (define-key 8859-1-map "_" (make-sparse-keymap)) - (define-key 8859-1-map "_a" 'insert-ordinal-indicator-feminine) - (define-key 8859-1-map "_o" 'insert-ordinal-indicator-masculine) - (define-key 8859-1-map "`" (make-sparse-keymap)) - (define-key 8859-1-map "`A" 'insert-A-grave) - (define-key 8859-1-map "`E" 'insert-E-grave) - (define-key 8859-1-map "`I" 'insert-I-grave) - (define-key 8859-1-map "`O" 'insert-O-grave) - (define-key 8859-1-map "`U" 'insert-U-grave) - (define-key 8859-1-map "`a" 'insert-a-grave) - (define-key 8859-1-map "`e" 'insert-e-grave) - (define-key 8859-1-map "`i" 'insert-i-grave) - (define-key 8859-1-map "`o" 'insert-o-grave) - (define-key 8859-1-map "`u" 'insert-u-grave) - (define-key 8859-1-map "a" 'insert-a-ring) - (define-key 8859-1-map "e" 'insert-ae) - (define-key 8859-1-map "c" 'insert-cent-sign) - (define-key 8859-1-map "d" 'insert-d-stroke) - (define-key 8859-1-map "o" 'insert-degree-sign) - (define-key 8859-1-map "s" 'insert-ss) - (define-key 8859-1-map "t" 'insert-thorn) - (define-key 8859-1-map "u" 'insert-micro-sign) - (define-key 8859-1-map "x" 'insert-multiplication-sign) - (define-key 8859-1-map "|" 'insert-broken-vertical-line) - (define-key 8859-1-map "~" (make-sparse-keymap)) - (define-key 8859-1-map "~A" 'insert-A-tilde) - (define-key 8859-1-map "~N" 'insert-N-tilde) - (define-key 8859-1-map "~O" 'insert-O-tilde) - (define-key 8859-1-map "~a" 'insert-a-tilde) - (define-key 8859-1-map "~n" 'insert-n-tilde) - (define-key 8859-1-map "~o" 'insert-o-tilde) - (define-key 8859-1-map "~~" 'insert-not-sign) - (if (not (lookup-key global-map "\C-x8")) - (define-key global-map "\C-x8" 8859-1-map)) -) -(defalias '8859-1-map 8859-1-map) - -(provide 'iso-insert) - -;;; 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 @@ -;;; iso-swed.el --- set up char tables for ISO 8859/1 for Swedish/Finnish ttys - -;; Copyright (C) 1987, 2001-2017 Free Software Foundation, Inc. - -;; Author: Howard Gayle -;; Maintainer: emacs-devel@gnu.org -;; Keywords: i18n -;; Obsolete-since: 22.1 - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Written by Howard Gayle. See case-table.el for details. - -;;; Code: - -;; This code sets up to display ISO 8859/1 characters on -;; terminals that have ASCII in the G0 set and a Swedish/Finnish -;; version of ISO 646 in the G1 set. The G1 set differs from -;; ASCII as follows: -;; -;; ASCII G1 -;; $ general currency sign -;; @ capital E with acute accent -;; [ capital A with diaeresis or umlaut mark -;; \ capital O with diaeresis or umlaut mark -;; ] capital A with ring -;; ^ capital U with diaeresis or umlaut mark -;; ` small e with acute accent -;; { small a with diaeresis or umlaut mark -;; | small o with diaeresis or umlaut mark -;; } small a with ring -;; ~ small u with diaeresis or umlaut mark - -(require 'disp-table) - -(standard-display-ascii 160 "{_}") ; NBSP (no-break space) -(standard-display-ascii 161 "{!}") ; inverted exclamation mark -(standard-display-ascii 162 "{c}") ; cent sign -(standard-display-ascii 163 "{GBP}") ; pound sign -(standard-display-g1 164 ?$) ; general currency sign -(standard-display-ascii 165 "{JPY}") ; yen sign -(standard-display-ascii 166 "{|}") ; broken vertical line -(standard-display-ascii 167 "{S}") ; section sign -(standard-display-ascii 168 "{\"}") ; diaeresis -(standard-display-ascii 169 "{C}") ; copyright sign -(standard-display-ascii 170 "{_a}") ; ordinal indicator, feminine -(standard-display-ascii 171 "{<<}") ; left angle quotation mark -(standard-display-ascii 172 "{~}") ; not sign -(standard-display-ascii 173 "{-}") ; soft hyphen -(standard-display-ascii 174 "{R}") ; registered sign -(standard-display-ascii 175 "{=}") ; macron -(standard-display-ascii 176 "{o}") ; degree sign -(standard-display-ascii 177 "{+-}") ; plus or minus sign -(standard-display-ascii 178 "{2}") ; superscript two -(standard-display-ascii 179 "{3}") ; superscript three -(standard-display-ascii 180 "{'}") ; acute accent -(standard-display-ascii 181 "{u}") ; micro sign -(standard-display-ascii 182 "{P}") ; pilcrow -(standard-display-ascii 183 "{.}") ; middle dot -(standard-display-ascii 184 "{,}") ; cedilla -(standard-display-ascii 185 "{1}") ; superscript one -(standard-display-ascii 186 "{_o}") ; ordinal indicator, masculine -(standard-display-ascii 187 "{>>}") ; right angle quotation mark -(standard-display-ascii 188 "{1/4}") ; fraction one-quarter -(standard-display-ascii 189 "{1/2}") ; fraction one-half -(standard-display-ascii 190 "{3/4}") ; fraction three-quarters -(standard-display-ascii 191 "{?}") ; inverted question mark -(standard-display-ascii 192 "{`A}") ; A with grave accent -(standard-display-ascii 193 "{'A}") ; A with acute accent -(standard-display-ascii 194 "{^A}") ; A with circumflex accent -(standard-display-ascii 195 "{~A}") ; A with tilde -(standard-display-g1 196 ?[) ; A with diaeresis or umlaut mark -(standard-display-g1 197 ?]) ; A with ring -(standard-display-ascii 198 "{AE}") ; AE diphthong -(standard-display-ascii 199 "{,C}") ; C with cedilla -(standard-display-ascii 200 "{`E}") ; E with grave accent -(standard-display-g1 201 ?@) ; E with acute accent -(standard-display-ascii 202 "{^E}") ; E with circumflex accent -(standard-display-ascii 203 "{\"E}") ; E with diaeresis or umlaut mark -(standard-display-ascii 204 "{`I}") ; I with grave accent -(standard-display-ascii 205 "{'I}") ; I with acute accent -(standard-display-ascii 206 "{^I}") ; I with circumflex accent -(standard-display-ascii 207 "{\"I}") ; I with diaeresis or umlaut mark -(standard-display-ascii 208 "{-D}") ; D with stroke, Icelandic eth -(standard-display-ascii 209 "{~N}") ; N with tilde -(standard-display-ascii 210 "{`O}") ; O with grave accent -(standard-display-ascii 211 "{'O}") ; O with acute accent -(standard-display-ascii 212 "{^O}") ; O with circumflex accent -(standard-display-ascii 213 "{~O}") ; O with tilde -(standard-display-g1 214 ?\\) ; O with diaeresis or umlaut mark -(standard-display-ascii 215 "{x}") ; multiplication sign -(standard-display-ascii 216 "{/O}") ; O with slash -(standard-display-ascii 217 "{`U}") ; U with grave accent -(standard-display-ascii 218 "{'U}") ; U with acute accent -(standard-display-ascii 219 "{^U}") ; U with circumflex accent -(standard-display-g1 220 ?^) ; U with diaeresis or umlaut mark -(standard-display-ascii 221 "{'Y}") ; Y with acute accent -(standard-display-ascii 222 "{TH}") ; capital thorn, Icelandic -(standard-display-ascii 223 "{ss}") ; small sharp s, German -(standard-display-ascii 224 "{`a}") ; a with grave accent -(standard-display-ascii 225 "{'a}") ; a with acute accent -(standard-display-ascii 226 "{^a}") ; a with circumflex accent -(standard-display-ascii 227 "{~a}") ; a with tilde -(standard-display-g1 228 ?{) ; a with diaeresis or umlaut mark -(standard-display-g1 229 ?}) ; a with ring -(standard-display-ascii 230 "{ae}") ; ae diphthong -(standard-display-ascii 231 "{,c}") ; c with cedilla -(standard-display-ascii 232 "{`e}") ; e with grave accent -(standard-display-g1 233 ?`) ; e with acute accent -(standard-display-ascii 234 "{^e}") ; e with circumflex accent -(standard-display-ascii 235 "{\"e}") ; e with diaeresis or umlaut mark -(standard-display-ascii 236 "{`i}") ; i with grave accent -(standard-display-ascii 237 "{'i}") ; i with acute accent -(standard-display-ascii 238 "{^i}") ; i with circumflex accent -(standard-display-ascii 239 "{\"i}") ; i with diaeresis or umlaut mark -(standard-display-ascii 240 "{-d}") ; d with stroke, Icelandic eth -(standard-display-ascii 241 "{~n}") ; n with tilde -(standard-display-ascii 242 "{`o}") ; o with grave accent -(standard-display-ascii 243 "{'o}") ; o with acute accent -(standard-display-ascii 244 "{^o}") ; o with circumflex accent -(standard-display-ascii 245 "{~o}") ; o with tilde -(standard-display-g1 246 ?|) ; o with diaeresis or umlaut mark -(standard-display-ascii 247 "{/}") ; division sign -(standard-display-ascii 248 "{/o}") ; o with slash -(standard-display-ascii 249 "{`u}") ; u with grave accent -(standard-display-ascii 250 "{'u}") ; u with acute accent -(standard-display-ascii 251 "{^u}") ; u with circumflex accent -(standard-display-g1 252 ?~) ; u with diaeresis or umlaut mark -(standard-display-ascii 253 "{'y}") ; y with acute accent -(standard-display-ascii 254 "{th}") ; small thorn, Icelandic -(standard-display-ascii 255 "{\"y}") ; small y with diaeresis or umlaut mark - -(provide 'iso-swed) - -;;; 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 @@ -;;; resume.el --- process command line args from within a suspended Emacs job - -;; Copyright (C) 1992, 2001-2017 Free Software Foundation, Inc. - -;; Author: Joe Wells <jbw@bucsf.bu.edu> -;; Adapted-By: ESR -;; Keywords: processes -;; Obsolete-since: 23.1 - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; The purpose of this library is to handle command line arguments -;; when you resume an existing Emacs job. - -;; In order to use it, you must put this code in your .emacs file. - -;; (add-hook 'suspend-hook 'resume-suspend-hook) -;; (add-hook 'suspend-resume-hook 'resume-process-args) - -;; You can't get the benefit of this library by using the `emacs' command, -;; since that always starts a new Emacs job. Instead you must use a -;; command called `edit' which knows how to resume an existing Emacs job -;; if you have one, or start a new Emacs job if you don't have one. - -;; To define the `edit' command, run the script etc/emacs.csh (if you use CSH), -;; or etc/emacs.bash if you use BASH. You would normally do this in your -;; login script. - -;; Stephan Gildea suggested bug fix (gildea@bbn.com). -;; Ideas from Michael DeCorte and other people. - -;;; Code: - -(defvar resume-emacs-args-file (expand-file-name "~/.emacs_args") - "This file is where arguments are placed for a suspended Emacs job.") - -(defvar resume-emacs-args-buffer " *Command Line Args*" - "Buffer that is used by `resume-process-args'.") - -(defun resume-process-args () - "Handler for command line args given when Emacs is resumed." - (let ((start-buffer (current-buffer)) - (args-buffer (get-buffer-create resume-emacs-args-buffer)) - length args - (command-line-default-directory default-directory)) - (unwind-protect - (progn - (set-buffer args-buffer) - (erase-buffer) - ;; get the contents of resume-emacs-args-file - (condition-case () - (let ((result (insert-file-contents resume-emacs-args-file))) - (setq length (car (cdr result)))) - ;; the file doesn't exist, ergo no arguments - (file-error - (erase-buffer) - (setq length 0))) - (if (<= length 0) - (setq args nil) - ;; get the arguments from the buffer - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward " \t\n") - (let ((begin (point))) - (skip-chars-forward "^ \t\n") - (setq args (cons (buffer-substring begin (point)) args))) - (skip-chars-forward " \t\n")) - ;; arguments are now in reverse order - (setq args (nreverse args)) - ;; make sure they're not read again - (erase-buffer)) - (resume-write-buffer-to-file (current-buffer) resume-emacs-args-file) - ;; if nothing was in buffer, args will be null - (or (null args) - (setq command-line-default-directory - (file-name-as-directory (car args)) - args (cdr args))) - ;; actually process the arguments - (command-line-1 args)) - ;; If the command line args don't result in a find-file, the - ;; buffer will be left in args-buffer. So we change back to the - ;; original buffer. The reason I don't just use - ;; (let ((default-directory foo)) - ;; (command-line-1 args)) - ;; in the context of the original buffer is because let does not - ;; work properly with buffer-local variables. - (if (eq (current-buffer) args-buffer) - (set-buffer start-buffer))))) - -;;;###autoload -(defun resume-suspend-hook () - "Clear out the file used for transmitting args when Emacs resumes." - (with-current-buffer (get-buffer-create resume-emacs-args-buffer) - (erase-buffer) - (resume-write-buffer-to-file (current-buffer) resume-emacs-args-file))) - -(defun resume-write-buffer-to-file (buffer file) - "Writes the contents of BUFFER into FILE, if permissions allow." - (if (not (file-writable-p file)) - (error "No permission to write file %s" file)) - (with-current-buffer buffer - (clear-visited-file-modtime) - (save-restriction - (widen) - (write-region (point-min) (point-max) file nil 'quiet)) - (set-buffer-modified-p nil))) - -(provide 'resume) - -;;; 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 @@ -;;; scribe.el --- scribe mode, and its idiosyncratic commands - -;; Copyright (C) 1985, 2001-2017 Free Software Foundation, Inc. - -;; Author: William Sommerfeld -;; (according to ack.texi) -;; Maintainer: emacs-devel@gnu.org -;; Keywords: wp -;; Obsolete-since: 22.1 - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; A major mode for editing source in written for the Scribe text formatter. -;; Knows about Scribe syntax and standard layout rules. The command to -;; run Scribe on a buffer is bogus; someone interested should fix it. - -;;; Code: - -(defvar compile-command) - -(defgroup scribe nil - "Scribe mode." - :prefix "scribe-" - :group 'wp) - -(defvar scribe-mode-syntax-table nil - "Syntax table used while in scribe mode.") - -(defvar scribe-mode-abbrev-table nil - "Abbrev table used while in scribe mode.") - -(defcustom scribe-fancy-paragraphs nil - "Non-nil makes Scribe mode use a different style of paragraph separation." - :type 'boolean - :group 'scribe) - -(defcustom scribe-electric-quote nil - "Non-nil makes insert of double quote use \\=`\\=` or \\='\\=' depending on context." - :type 'boolean - :group 'scribe) - -(defcustom scribe-electric-parenthesis nil - "Non-nil makes parenthesis char ( (]}> ) automatically insert its close -if typed after an @Command form." - :type 'boolean - :group 'scribe) - -(defconst scribe-open-parentheses "[({<" - "Open parenthesis characters for Scribe.") - -(defconst scribe-close-parentheses "])}>" - "Close parenthesis characters for Scribe. -These should match up with `scribe-open-parenthesis'.") - -(if (null scribe-mode-syntax-table) - (let ((st (syntax-table))) - (unwind-protect - (progn - (setq scribe-mode-syntax-table (copy-syntax-table - text-mode-syntax-table)) - (set-syntax-table scribe-mode-syntax-table) - (modify-syntax-entry ?\" " ") - (modify-syntax-entry ?\\ " ") - (modify-syntax-entry ?@ "w ") - (modify-syntax-entry ?< "(> ") - (modify-syntax-entry ?> ")< ") - (modify-syntax-entry ?[ "(] ") - (modify-syntax-entry ?] ")[ ") - (modify-syntax-entry ?{ "(} ") - (modify-syntax-entry ?} "){ ") - (modify-syntax-entry ?' "w ")) - (set-syntax-table st)))) - -(defvar scribe-mode-map nil) - -(if scribe-mode-map - nil - (setq scribe-mode-map (make-sparse-keymap)) - (define-key scribe-mode-map "\t" 'scribe-tab) - (define-key scribe-mode-map "\e\t" 'tab-to-tab-stop) - (define-key scribe-mode-map "\es" 'center-line) - (define-key scribe-mode-map "\e}" 'up-list) - (define-key scribe-mode-map "\eS" 'center-paragraph) - (define-key scribe-mode-map "\"" 'scribe-insert-quote) - (define-key scribe-mode-map "(" 'scribe-parenthesis) - (define-key scribe-mode-map "[" 'scribe-parenthesis) - (define-key scribe-mode-map "{" 'scribe-parenthesis) - (define-key scribe-mode-map "<" 'scribe-parenthesis) - (define-key scribe-mode-map "\C-c\C-c" 'scribe-chapter) - (define-key scribe-mode-map "\C-c\C-t" 'scribe-section) - (define-key scribe-mode-map "\C-c\C-s" 'scribe-subsection) - (define-key scribe-mode-map "\C-c\C-v" 'scribe-insert-environment) - (define-key scribe-mode-map "\C-c\C-e" 'scribe-bracket-region-be) - (define-key scribe-mode-map "\C-c[" 'scribe-begin) - (define-key scribe-mode-map "\C-c]" 'scribe-end) - (define-key scribe-mode-map "\C-c\C-i" 'scribe-italicize-word) - (define-key scribe-mode-map "\C-c\C-b" 'scribe-bold-word) - (define-key scribe-mode-map "\C-c\C-u" 'scribe-underline-word)) - -;;;###autoload -(define-derived-mode scribe-mode text-mode "Scribe" - "Major mode for editing files of Scribe (a text formatter) source. -Scribe-mode is similar to text-mode, with a few extra commands added. -\\{scribe-mode-map} - -Interesting variables: - -`scribe-fancy-paragraphs' - Non-nil makes Scribe mode use a different style of paragraph separation. - -`scribe-electric-quote' - Non-nil makes insert of double quote use \\=`\\=` or \\='\\=' depending on context. - -`scribe-electric-parenthesis' - Non-nil makes an open-parenthesis char (one of `([<{') - automatically insert its close if typed after an @Command form." - (set (make-local-variable 'comment-start) "@Comment[") - (set (make-local-variable 'comment-start-skip) (concat "@Comment[" scribe-open-parentheses "]")) - (set (make-local-variable 'comment-column) 0) - (set (make-local-variable 'comment-end) "]") - (set (make-local-variable 'paragraph-start) - (concat "\\([\n\f]\\)\\|\\(@\\w+[" - scribe-open-parentheses - "].*[" - scribe-close-parentheses - "]$\\)")) - (set (make-local-variable 'paragraph-separate) - (if scribe-fancy-paragraphs paragraph-start "$")) - (set (make-local-variable 'sentence-end) - "\\([.?!]\\|@:\\)[]\"')}]*\\($\\| $\\|\t\\| \\)[ \t\n]*") - (set (make-local-variable 'compile-command) - (concat "scribe " - (if buffer-file-name - (shell-quote-argument (buffer-file-name)))))) - -(defun scribe-tab () - (interactive) - (insert "@\\")) - -;; This algorithm could probably be improved somewhat. -;; Right now, it loses seriously... - -(defun scribe () - "Run Scribe on the current buffer." - (interactive) - (call-interactively 'compile)) - -(defun scribe-envelop-word (string count) - "Surround current word with Scribe construct @STRING[...]. -COUNT specifies how many words to surround. A negative count means -to skip backward." - (let ((spos (point)) (epos (point)) (ccoun 0) noparens) - (if (not (zerop count)) - (progn (if (= (char-syntax (preceding-char)) ?w) - (forward-sexp (min -1 count))) - (setq spos (point)) - (if (looking-at (concat "@\\w[" scribe-open-parentheses "]")) - (forward-char 2) - (goto-char epos) - (skip-chars-backward "\\W") - (forward-char -1)) - (forward-sexp (max count 1)) - (setq epos (point)))) - (goto-char spos) - (while (and (< ccoun (length scribe-open-parentheses)) - (save-excursion - (or (search-forward (char-to-string - (aref scribe-open-parentheses ccoun)) - epos t) - (search-forward (char-to-string - (aref scribe-close-parentheses ccoun)) - epos t))) - (setq ccoun (1+ ccoun)))) - (if (>= ccoun (length scribe-open-parentheses)) - (progn (goto-char epos) - (insert "@end(" string ")") - (goto-char spos) - (insert "@begin(" string ")")) - (goto-char epos) - (insert (aref scribe-close-parentheses ccoun)) - (goto-char spos) - (insert "@" string (aref scribe-open-parentheses ccoun)) - (goto-char epos) - (forward-char 3) - (skip-chars-forward scribe-close-parentheses)))) - -(defun scribe-underline-word (count) - "Underline COUNT words around point by means of Scribe constructs." - (interactive "p") - (scribe-envelop-word "u" count)) - -(defun scribe-bold-word (count) - "Boldface COUNT words around point by means of Scribe constructs." - (interactive "p") - (scribe-envelop-word "b" count)) - -(defun scribe-italicize-word (count) - "Italicize COUNT words around point by means of Scribe constructs." - (interactive "p") - (scribe-envelop-word "i" count)) - -(defun scribe-begin () - (interactive) - (insert "\n") - (forward-char -1) - (scribe-envelop-word "Begin" 0) - (re-search-forward (concat "[" scribe-open-parentheses "]"))) - -(defun scribe-end () - (interactive) - (insert "\n") - (forward-char -1) - (scribe-envelop-word "End" 0) - (re-search-forward (concat "[" scribe-open-parentheses "]"))) - -(defun scribe-chapter () - (interactive) - (insert "\n") - (forward-char -1) - (scribe-envelop-word "Chapter" 0) - (re-search-forward (concat "[" scribe-open-parentheses "]"))) - -(defun scribe-section () - (interactive) - (insert "\n") - (forward-char -1) - (scribe-envelop-word "Section" 0) - (re-search-forward (concat "[" scribe-open-parentheses "]"))) - -(defun scribe-subsection () - (interactive) - (insert "\n") - (forward-char -1) - (scribe-envelop-word "SubSection" 0) - (re-search-forward (concat "[" scribe-open-parentheses "]"))) - -(defun scribe-bracket-region-be (env min max) - (interactive "sEnvironment: \nr") - (save-excursion - (goto-char max) - (insert "@end(" env ")\n") - (goto-char min) - (insert "@begin(" env ")\n"))) - -(defun scribe-insert-environment (env) - (interactive "sEnvironment: ") - (scribe-bracket-region-be env (point) (point)) - (forward-line 1) - (insert ?\n) - (forward-char -1)) - -(defun scribe-insert-quote (count) - "Insert \\=`\\=`, \\='\\=' or \" according to preceding character. -If `scribe-electric-quote' is non-nil, insert \\=`\\=`, \\='\\=' or \" according -to preceding character. With numeric arg N, always insert N \" characters. -Else just insert \"." - (interactive "P") - (if (or count (not scribe-electric-quote)) - (self-insert-command (prefix-numeric-value count)) - (let (lastfore lastback lastquote) - (insert - (cond - ((= (preceding-char) ?\\) ?\") - ((bobp) "``") - (t - (setq lastfore (save-excursion (and (search-backward - "``" (- (point) 1000) t) - (point))) - lastback (save-excursion (and (search-backward - "''" (- (point) 1000) t) - (point))) - lastquote (save-excursion (and (search-backward - "\"" (- (point) 100) t) - (point)))) - (if (not lastquote) - (cond ((not lastfore) "``") - ((not lastback) "''") - ((> lastfore lastback) "''") - (t "``")) - (cond ((and (not lastback) (not lastfore)) "\"") - ((and lastback (not lastfore) (> lastquote lastback)) "\"") - ((and lastback (not lastfore) (> lastback lastquote)) "``") - ((and lastfore (not lastback) (> lastquote lastfore)) "\"") - ((and lastfore (not lastback) (> lastfore lastquote)) "''") - ((and (> lastquote lastfore) (> lastquote lastback)) "\"") - ((> lastfore lastback) "''") - (t "``"))))))))) - -(defun scribe-parenthesis (count) - "If scribe-electric-parenthesis is non-nil, insertion of an open-parenthesis -character inserts the following close parenthesis character if the -preceding text is of the form @Command." - (interactive "P") - (self-insert-command (prefix-numeric-value count)) - (let (at-command paren-char point-save) - (if (or count (not scribe-electric-parenthesis)) - nil - (save-excursion - (forward-char -1) - (setq point-save (point)) - (skip-chars-backward (concat "^ \n\t\f" scribe-open-parentheses)) - (setq at-command (and (equal (following-char) ?@) - (/= (point) (1- point-save))))) - (if (and at-command - (setq paren-char - (string-match (regexp-quote - (char-to-string (preceding-char))) - scribe-open-parentheses))) - (save-excursion - (insert (aref scribe-close-parentheses paren-char))))))) - -(provide 'scribe) - -;;; 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 @@ -;;; spell.el --- spelling correction interface for Emacs - -;; Copyright (C) 1985, 2001-2017 Free Software Foundation, Inc. - -;; Maintainer: emacs-devel@gnu.org -;; Keywords: wp, unix -;; Obsolete-since: 23.1 -;; (not in obsolete/ directory then, but all functions marked obsolete) - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This mode provides an Emacs interface to the UNIX spell(1) program. -;; Entry points are `spell-buffer', `spell-word', `spell-region' and -;; `spell-string'. - -;; See also ispell.el for an interface to the ispell program. - -;;; Code: - -(defgroup spell nil - "Interface to the UNIX spell(1) program." - :prefix "spell-" - :group 'applications) - -(defcustom spell-command "spell" - "Command to run the spell program." - :type 'string - :group 'spell) - -(defcustom spell-filter nil - "Filter function to process text before passing it to spell program. -This function might remove text-processor commands. -nil means don't alter the text before checking it." - :type '(choice (const nil) function) - :group 'spell) - -;;;###autoload -(put 'spell-filter 'risky-local-variable t) - -;;;###autoload -(defun spell-buffer () - "Check spelling of every word in the buffer. -For each incorrect word, you are asked for the correct spelling -and then put into a query-replace to fix some or all occurrences. -If you do not want to change a word, just give the same word -as its \"correct\" spelling; then the query replace is skipped." - (interactive) - ;; Don't warn about spell-region being obsolete. - (with-no-warnings - (spell-region (point-min) (point-max) "buffer"))) -;;;###autoload -(make-obsolete 'spell-buffer 'ispell-buffer "23.1") - -;;;###autoload -(defun spell-word () - "Check spelling of word at or before point. -If it is not correct, ask user for the correct spelling -and `query-replace' the entire buffer to substitute it." - (interactive) - (let (beg end spell-filter) - (save-excursion - (if (not (looking-at "\\<")) - (forward-word -1)) - (setq beg (point)) - (forward-word 1) - (setq end (point))) - ;; Don't warn about spell-region being obsolete. - (with-no-warnings - (spell-region beg end (buffer-substring beg end))))) -;;;###autoload -(make-obsolete 'spell-word 'ispell-word "23.1") - -;;;###autoload -(defun spell-region (start end &optional description) - "Like `spell-buffer' but applies only to region. -Used in a program, applies from START to END. -DESCRIPTION is an optional string naming the unit being checked: -for example, \"word\"." - (interactive "r") - (let ((filter spell-filter) - (buf (get-buffer-create " *temp*"))) - (with-current-buffer buf - (widen) - (erase-buffer)) - (message "Checking spelling of %s..." (or description "region")) - (if (and (null filter) (= ?\n (char-after (1- end)))) - (if (string= "spell" spell-command) - (call-process-region start end "spell" nil buf) - (call-process-region start end shell-file-name - nil buf nil "-c" spell-command)) - (let ((oldbuf (current-buffer))) - (with-current-buffer buf - (insert-buffer-substring oldbuf start end) - (or (bolp) (insert ?\n)) - (if filter (funcall filter)) - (if (string= "spell" spell-command) - (call-process-region (point-min) (point-max) "spell" t buf) - (call-process-region (point-min) (point-max) shell-file-name - t buf nil "-c" spell-command))))) - (message "Checking spelling of %s...%s" - (or description "region") - (if (with-current-buffer buf - (> (buffer-size) 0)) - "not correct" - "correct")) - (let (word newword - (case-fold-search t) - (case-replace t)) - (while (with-current-buffer buf - (> (buffer-size) 0)) - (with-current-buffer buf - (goto-char (point-min)) - (setq word (downcase - (buffer-substring (point) - (progn (end-of-line) (point))))) - (forward-char 1) - (delete-region (point-min) (point)) - (setq newword - (read-string (concat "`" word - "' not recognized; edit a replacement: ") - word)) - (flush-lines (concat "^" (regexp-quote word) "$"))) - (if (not (equal word newword)) - (progn - (goto-char (point-min)) - (query-replace-regexp (concat "\\b" (regexp-quote word) "\\b") - newword))))))) -;;;###autoload -(make-obsolete 'spell-region 'ispell-region "23.1") - -;;;###autoload -(defun spell-string (string) - "Check spelling of string supplied as argument." - (interactive "sSpell string: ") - (with-temp-buffer - (widen) - (erase-buffer) - (insert string "\n") - (if (string= "spell" spell-command) - (call-process-region (point-min) (point-max) "spell" - t t) - (call-process-region (point-min) (point-max) shell-file-name - t t nil "-c" spell-command)) - (if (= 0 (buffer-size)) - (message "%s is correct" string) - (goto-char (point-min)) - (while (search-forward "\n" nil t) - (replace-match " ")) - (message "%sincorrect" (buffer-substring 1 (point-max)))))) -;;;###autoload -(make-obsolete 'spell-string "The `spell' package is obsolete - use `ispell'." - "23.1") - -(provide 'spell) - -;;; 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 @@ -;;; swedish.el --- miscellaneous functions for dealing with Swedish - -;; Copyright (C) 1988, 2001-2017 Free Software Foundation, Inc. - -;; Author: Howard Gayle -;; Maintainer: emacs-devel@gnu.org -;; Keywords: i18n -;; Obsolete-since: 22.1 - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Fixme: Is this actually used? if so, it should be in language, -;; possibly as a feature property of Swedish, probably defining a -;; `swascii' coding system. - -;;; Code: - -;; Written by Howard Gayle. See case-table.el for details. - -;; See iso-swed.el for a description of the character set. - -(defvar mail-send-hook) -(defvar news-group-hook-alist) -(defvar news-inews-hook) - -(defvar swedish-re - "[ \t\n]\\(och\\|att\\|en\\|{r\\|\\[R\\|p}\\|P\\]\\|som\\|det\\|av\\|den\\|f|r\\|F\\\\R\\)[ \t\n.,?!:;'\")}]" - "Regular expression for common Swedish words.") - -(defvar swascii-to-8859-trans - (let ((string (make-string 256 ? )) - (i 0)) - (while (< i 256) - (aset string i i) - (setq i (1+ i))) - (aset string ?\[ 196) - (aset string ?\] 197) - (aset string ?\\ 214) - (aset string ?^ 220) - (aset string ?\{ 228) - (aset string ?\} 229) - (aset string ?\` 233) - (aset string ?\| 246) - (aset string ?~ 252) - string) - "Trans table from SWASCII to 8859.") - -; $ is not converted because it almost always means US -; dollars, not general currency sign. @ is not converted -; because it is more likely to be an at sign in a mail address -; than an E with acute accent. - -(defun swascii-to-8859-buffer () - "Convert characters in buffer from Swedish/Finnish-ascii to ISO 8859/1. -Works even on read-only buffers. `$' and `@' are not converted." - (interactive) - (let ((buffer-read-only nil)) - (translate-region (point-min) (point-max) swascii-to-8859-trans))) - -(defun swascii-to-8859-buffer-maybe () - "Call swascii-to-8859-buffer if the buffer looks like Swedish-ascii. -Leaves point just after the word that looks Swedish." - (interactive) - (let ((case-fold-search t)) - (if (re-search-forward swedish-re nil t) - (swascii-to-8859-buffer)))) - -(setq rmail-show-message-hook 'swascii-to-8859-buffer-maybe) - -(setq news-group-hook-alist - (append '(("^swnet." . swascii-to-8859-buffer-maybe)) - (bound-and-true-p news-group-hook-alist))) - -(defvar 8859-to-swascii-trans - (let ((string (make-string 256 ? )) - (i 0)) - (while (< i 256) - (aset string i i) - (setq i (1+ i))) - (aset string 164 ?$) - (aset string 196 ?\[) - (aset string 197 ?\]) - (aset string 201 ?@) - (aset string 214 ?\\) - (aset string 220 ?^) - (aset string 228 ?\{) - (aset string 229 ?\}) - (aset string 233 ?\`) - (aset string 246 ?\|) - (aset string 252 ?~) - string) - "8859 to SWASCII trans table.") - -(defun 8859-to-swascii-buffer () - "Convert characters in buffer from ISO 8859/1 to Swedish/Finnish-ascii." - (interactive "*") - (translate-region (point-min) (point-max) 8859-to-swascii-trans)) - -(setq mail-send-hook '8859-to-swascii-buffer) -(setq news-inews-hook '8859-to-swascii-buffer) - -;; It's not clear what purpose is served by a separate -;; Swedish mode that differs from Text mode only in having -;; a separate abbrev table. Nothing says that the abbrevs you -;; define in Text mode have to be English! - -;(defvar swedish-mode-abbrev-table nil -; "Abbrev table used while in swedish mode.") -;(define-abbrev-table 'swedish-mode-abbrev-table ()) - -;(defun swedish-mode () -; "Major mode for editing Swedish text intended for humans to -;read. Special commands:\\{text-mode-map} -;Turning on swedish-mode calls the value of the variable -;text-mode-hook, if that value is non-nil." -; (interactive) -; (kill-all-local-variables) -; (use-local-map text-mode-map) -; (setq mode-name "Swedish") -; (setq major-mode 'swedish-mode) -; (setq local-abbrev-table swedish-mode-abbrev-table) -; (set-syntax-table text-mode-syntax-table) -; (run-mode-hooks 'text-mode-hook)) - -;(defun indented-swedish-mode () -; "Major mode for editing indented Swedish text intended for -;humans to read.\\{indented-text-mode-map} -;Turning on indented-swedish-mode calls the value of the -;variable text-mode-hook, if that value is non-nil." -; (interactive) -; (kill-all-local-variables) -; (use-local-map text-mode-map) -; (define-abbrev-table 'swedish-mode-abbrev-table ()) -; (setq local-abbrev-table swedish-mode-abbrev-table) -; (set-syntax-table text-mode-syntax-table) -; (make-local-variable 'indent-line-function) -; (setq indent-line-function 'indent-relative-maybe) -; (use-local-map indented-text-mode-map) -; (setq mode-name "Indented Swedish") -; (setq major-mode 'indented-swedish-mode) -; (run-mode-hooks 'text-mode-hook)) - -(provide 'swedish) - -;;; 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 @@ -;;; sym-comp.el --- mode-dependent symbol completion - -;; Copyright (C) 2004, 2008-2017 Free Software Foundation, Inc. - -;; Author: Dave Love <fx@gnu.org> -;; Keywords: extensions -;; URL: http://www.loveshack.ukfsn.org/emacs -;; Obsolete-since: 23.2 - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This defines `symbol-complete', which is a generalization of the -;; old `lisp-complete-symbol'. It provides the following hooks to -;; allow major modes to set up completion appropriate for the mode: -;; `symbol-completion-symbol-function', -;; `symbol-completion-completions-function', -;; `symbol-completion-predicate-function', -;; `symbol-completion-transform-function'. Typically it is only -;; necessary for a mode to set -;; `symbol-completion-completions-function' locally and to bind -;; `symbol-complete' appropriately. - -;; It's unfortunate that there doesn't seem to be a good way of -;; combining this with `complete-symbol'. - -;; There is also `symbol-completion-try-complete', for use with -;; Hippie-exp. - -;;; Code: - -;;;; Mode-dependent symbol completion. - -(defun symbol-completion-symbol () - "Default `symbol-completion-symbol-function'. -Uses `current-word' with the buffer narrowed to the part before -point." - (save-restriction - ;; Narrow in case point is in the middle of a symbol -- we want - ;; just the preceding part. - (narrow-to-region (point-min) (point)) - (current-word))) - -(defvar symbol-completion-symbol-function 'symbol-completion-symbol - "Function to return a partial symbol before point for completion. -The value it returns should be a string (or nil). -Major modes may set this locally if the default isn't appropriate. - -Beware: the length of the string STR returned need to be equal to the length -of text before point that's subject to completion. Typically, this amounts -to saying that STR is equal to -\(buffer-substring (- (point) (length STR)) (point)).") - -(defvar symbol-completion-completions-function nil - "Function to return possible symbol completions. -It takes an argument which is the string to be completed and -returns a value suitable for the second argument of -`try-completion'. This value need not use the argument, i.e. it -may be all possible completions, such as `obarray' in the case of -Emacs Lisp. - -Major modes may set this locally to allow them to support -`symbol-complete'. See also `symbol-completion-symbol-function', -`symbol-completion-predicate-function' and -`symbol-completion-transform-function'.") - -(defvar symbol-completion-predicate-function nil - "If non-nil, function to return a predicate for selecting symbol completions. -The function gets two args, the positions of the beginning and -end of the symbol to be completed. - -Major modes may set this locally if the default isn't -appropriate. This is a function returning a predicate so that -the predicate can be context-dependent, e.g. to select only -function names if point is at a function call position. The -function's args may be useful for determining the context.") - -(defvar symbol-completion-transform-function nil - "If non-nil, function to transform symbols in the symbol-completion buffer. -E.g., for Lisp, it may annotate the symbol as being a function, -not a variable. - -The function takes the symbol name as argument. If it needs to -annotate this, it should return a value suitable as an element of -the list passed to `display-completion-list'. - -The predicate being used for selecting completions (from -`symbol-completion-predicate-function') is available -dynamically-bound as `symbol-completion-predicate' in case the -transform needs it.") - -(defvar symbol-completion-predicate) - -;;;###autoload -(defun symbol-complete (&optional predicate) - "Perform completion of the symbol preceding point. -This is done in a way appropriate to the current major mode, -perhaps by interrogating an inferior interpreter. Compare -`complete-symbol'. -If no characters can be completed, display a list of possible completions. -Repeating the command at that point scrolls the list. - -When called from a program, optional arg PREDICATE is a predicate -determining which symbols are considered. - -This function requires `symbol-completion-completions-function' -to be set buffer-locally. Variables `symbol-completion-symbol-function', -`symbol-completion-predicate-function' and -`symbol-completion-transform-function' are also consulted." - (interactive) - ;; Fixme: Punt to `complete-symbol' in this case? - (unless (functionp symbol-completion-completions-function) - (error "symbol-completion-completions-function not defined")) - (let* ((pattern (or (funcall symbol-completion-symbol-function) - (error "No preceding symbol to complete"))) - ;; FIXME: We assume below that `pattern' holds the text just - ;; before point. This is a problem in the way - ;; symbol-completion-symbol-function was defined. - (predicate (or predicate - (if symbol-completion-predicate-function - (funcall symbol-completion-predicate-function - (- (point) (length pattern)) - (point))))) - (completions (funcall symbol-completion-completions-function - pattern)) - ;; In case the transform needs to access it. - (symbol-completion-predicate predicate) - (completion-extra-properties - (if (functionp symbol-completion-transform-function) - '(:annotation-function - (lambda (str) - (car-safe (cdr-safe - (funcall symbol-completion-transform-function - str)))))))) - (completion-in-region (- (point) (length pattern)) (point) - completions predicate))) - -(defvar he-search-string) -(defvar he-tried-table) -(defvar he-expand-list) -(declare-function he-init-string "hippie-exp" (beg end)) -(declare-function he-string-member "hippie-exp" (str lst &optional trans-case)) -(declare-function he-substitute-string "hippie-exp" (str &optional trans-case)) -(declare-function he-reset-string "hippie-exp" ()) - -;;;###autoload -(defun symbol-completion-try-complete (old) - "Completion function for use with `hippie-expand'. -Uses `symbol-completion-symbol-function' and -`symbol-completion-completions-function'. It is intended to be -used something like this in a major mode which provides symbol -completion: - - (if (featurep \\='hippie-exp) - (set (make-local-variable \\='hippie-expand-try-functions-list) - (cons \\='symbol-completion-try-complete - hippie-expand-try-functions-list)))" - (when (and symbol-completion-symbol-function - symbol-completion-completions-function) - (unless old - (let ((symbol (funcall symbol-completion-symbol-function))) - (he-init-string (- (point) (length symbol)) (point)) - (if (not (he-string-member he-search-string he-tried-table)) - (push he-search-string he-tried-table)) - (setq he-expand-list - (and symbol - (funcall symbol-completion-completions-function symbol))))) - (while (and he-expand-list - (he-string-member (car he-expand-list) he-tried-table)) - (pop he-expand-list)) - (if he-expand-list - (progn - (he-substitute-string (pop he-expand-list)) - t) - (if old (he-reset-string)) - nil))) - -;;; Emacs Lisp symbol completion. - -(defun lisp-completion-symbol () - "`symbol-completion-symbol-function' for Lisp." - (let ((end (point)) - (beg (with-syntax-table emacs-lisp-mode-syntax-table - (save-excursion - (backward-sexp 1) - (while (= (char-syntax (following-char)) ?\') - (forward-char 1)) - (point))))) - (buffer-substring-no-properties beg end))) - -(defun lisp-completion-predicate (beg end) - "`symbol-completion-predicate-function' for Lisp." - (save-excursion - (goto-char beg) - (if (not (eq (char-before) ?\()) - (lambda (sym) ;why not just nil ? -sm - ;To avoid interned symbols with - ;no slots. -- fx - (or (boundp sym) (fboundp sym) - (symbol-plist sym))) - ;; Looks like a funcall position. Let's double check. - (if (condition-case nil - (progn (up-list -2) (forward-char 1) - (eq (char-after) ?\()) - (error nil)) - ;; If the first element of the parent list is an open - ;; parenthesis we are probably not in a funcall position. - ;; Maybe a `let' varlist or something. - nil - ;; Else, we assume that a function name is expected. - 'fboundp)))) - -(defun lisp-symbol-completion-transform () - "`symbol-completion-transform-function' for Lisp." - (lambda (elt) - (if (and (not (eq 'fboundp symbol-completion-predicate)) - (fboundp (intern elt))) - (list elt " <f>") - elt))) - -(provide 'sym-comp) - -;;; sym-comp.el ends here |