+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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'.
-\f
-;;; 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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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)))
-\f
-(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)))
-\f
-;;; 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
projects / emacs.git / commitdiff