procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Remove mistakenly-added files

Browse source 
Problem reported by Glenn Morris in:
http://lists.gnu.org/archive/html/emacs-devel/2017-01/msg00008.html
* lisp/gnus/gnus-ems.el, lisp/gnus/gnus-sync.el:
* lisp/gnus/messcompat.el, lisp/nxml/nxml-glyph.el:
* lisp/nxml/nxml-uchnm.el, lisp/obsolete/awk-mode.el:
* lisp/obsolete/iso-acc.el, lisp/obsolete/iso-insert.el:
* lisp/obsolete/iso-swed.el, lisp/obsolete/resume.el:
* lisp/obsolete/scribe.el, lisp/obsolete/spell.el:
* lisp/obsolete/swedish.el, lisp/obsolete/sym-comp.el:
Remove files that were added by mistake during a merge.
This commit is contained in:
Paul Eggert 2017-01-01 20:23:38 -08:00
parent 214a67b00b
commit 367dadf554
14 changed files with 0 additions and 4363 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

266
lisp/gnus/gnus-ems.el
View file

@ -1,266 +0,0 @@
;;; gnus-ems.el --- functions for making Gnus work under different Emacsen
;; Copyright (C) 1995-2017 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(eval-when-compile
(require 'cl)
(require 'ring))
;;; Function aliases later to be redefined for XEmacs usage.
(defvar gnus-mouse-2 [mouse-2])
(defvar gnus-down-mouse-3 [down-mouse-3])
(defvar gnus-down-mouse-2 [down-mouse-2])
(defvar gnus-widget-button-keymap nil)
(defvar gnus-mode-line-modified
(if (featurep 'xemacs)
'("--**-" . "-----")
'("**" "--")))
(eval-and-compile
(autoload 'gnus-xmas-define "gnus-xmas")
(autoload 'gnus-xmas-redefine "gnus-xmas"))
(autoload 'gnus-get-buffer-create "gnus")
(autoload 'nnheader-find-etc-directory "nnheader")
(autoload 'smiley-region "smiley")
(defun gnus-kill-all-overlays ()
"Delete all overlays in the current buffer."
(let* ((overlayss (overlay-lists))
(buffer-read-only nil)
(overlays (delq nil (nconc (car overlayss) (cdr overlayss)))))
(while overlays
(delete-overlay (pop overlays)))))
;;; Mule functions.
(defun gnus-mule-max-width-function (el max-width)
`(let* ((val (eval (, el)))
(valstr (if (numberp val)
(int-to-string val) val)))
(if (> (length valstr) ,max-width)
(truncate-string-to-width valstr ,max-width)
valstr)))
(eval-and-compile
(if (featurep 'xemacs)
(gnus-xmas-define)
(defvar gnus-mouse-face-prop 'mouse-face
"Property used for highlighting mouse regions.")))
(defvar gnus-tmp-unread)
(defvar gnus-tmp-replied)
(defvar gnus-tmp-score-char)
(defvar gnus-tmp-indentation)
(defvar gnus-tmp-opening-bracket)
(defvar gnus-tmp-lines)
(defvar gnus-tmp-name)
(defvar gnus-tmp-closing-bracket)
(defvar gnus-tmp-subject-or-nil)
(defvar gnus-check-before-posting)
(defvar gnus-mouse-face)
(defvar gnus-group-buffer)
(defun gnus-ems-redefine ()
(cond
((featurep 'xemacs)
(gnus-xmas-redefine))
((featurep 'mule)
;; Mule and new Emacs definitions
;; [Note] Now there are three kinds of mule implementations,
;; original MULE, XEmacs/mule and Emacs 20+ including
;; MULE features. Unfortunately these APIs are different. In
;; particular, Emacs (including original Mule) and XEmacs are
;; quite different. However, this version of Gnus doesn't support
;; anything other than XEmacs 20+ and Emacs 20.3+.
;; Predicates to check are following:
;; (boundp 'MULE) is t only if Mule (original; anything older than
;; Mule 2.3) is running.
;; (featurep 'mule) is t when other mule variants are running.
;; It is possible to detect XEmacs/mule by (featurep 'mule) and
;; (featurep 'xemacs). In this case, the implementation for
;; XEmacs/mule may be shareable between XEmacs and XEmacs/mule.
(defvar gnus-summary-display-table nil
"Display table used in summary mode buffers.")
(defalias 'gnus-max-width-function 'gnus-mule-max-width-function)
(when (boundp 'gnus-check-before-posting)
(setq gnus-check-before-posting
(delq 'long-lines
(delq 'control-chars gnus-check-before-posting))))
(defun gnus-summary-line-format-spec ()
(insert gnus-tmp-unread gnus-tmp-replied
gnus-tmp-score-char gnus-tmp-indentation)
(put-text-property
(point)
(progn
(insert
gnus-tmp-opening-bracket
(format "%4d: %-20s"
gnus-tmp-lines
(if (> (length gnus-tmp-name) 20)
(truncate-string-to-width gnus-tmp-name 20)
gnus-tmp-name))
gnus-tmp-closing-bracket)
(point))
gnus-mouse-face-prop gnus-mouse-face)
(insert " " gnus-tmp-subject-or-nil "\n")))))
;; Clone of `appt-select-lowest-window' in appt.el.
(defun gnus-select-lowest-window ()
"Select the lowest window on the frame."
(let ((lowest-window (selected-window))
(bottom-edge (nth 3 (window-edges))))
(walk-windows (lambda (w)
(let ((next-bottom-edge (nth 3 (window-edges w))))
(when (< bottom-edge next-bottom-edge)
(setq bottom-edge next-bottom-edge
lowest-window w)))))
(select-window lowest-window)))
(defun gnus-region-active-p ()
"Say whether the region is active."
(and (boundp 'transient-mark-mode)
transient-mark-mode
(boundp 'mark-active)
mark-active))
(defun gnus-mark-active-p ()
"Non-nil means the mark and region are currently active in this buffer."
mark-active) ; aliased to region-exists-p in XEmacs.
(autoload 'gnus-alive-p "gnus-util")
(autoload 'mm-disable-multibyte "mm-util")
;;; Image functions.
(defun gnus-image-type-available-p (type)
(and (fboundp 'image-type-available-p)
(if (fboundp 'display-images-p)
(display-images-p)
t)
(image-type-available-p type)))
(defun gnus-create-image (file &optional type data-p &rest props)
(let ((face (plist-get props :face)))
(when face
(setq props (plist-put props :foreground (face-foreground face)))
(setq props (plist-put props :background (face-background face))))
(ignore-errors
(apply 'create-image file type data-p props))))
(defun gnus-put-image (glyph &optional string category)
(let ((point (point)))
(insert-image glyph (or string " "))
(put-text-property point (point) 'gnus-image-category category)
(unless string
(put-text-property (1- (point)) (point)
'gnus-image-text-deletable t))
glyph))
(defun gnus-remove-image (image &optional category)
"Remove the image matching IMAGE and CATEGORY found first."
(let ((start (point-min))
val end)
(while (and (not end)
(or (setq val (get-text-property start 'display))
(and (setq start
(next-single-property-change start 'display))
(setq val (get-text-property start 'display)))))
(setq end (or (next-single-property-change start 'display)
(point-max)))
(if (and (equal val image)
(equal (get-text-property start 'gnus-image-category)
category))
(progn
(put-text-property start end 'display nil)
(when (get-text-property start 'gnus-image-text-deletable)
(delete-region start end)))
(unless (= end (point-max))
(setq start end
end nil))))))
(defmacro gnus-string-mark-left-to-right (string)
(if (fboundp 'bidi-string-mark-left-to-right)
`(bidi-string-mark-left-to-right ,string)
string))
(eval-and-compile
;; XEmacs does not have window-inside-pixel-edges
(defalias 'gnus-window-inside-pixel-edges
(if (fboundp 'window-inside-pixel-edges)
'window-inside-pixel-edges
'window-pixel-edges))
(if (or (featurep 'emacs) (fboundp 'set-process-plist))
(progn ; these exist since Emacs 22.1
(defalias 'gnus-set-process-plist 'set-process-plist)
(defalias 'gnus-process-plist 'process-plist)
(defalias 'gnus-process-get 'process-get)
(defalias 'gnus-process-put 'process-put))
(defun gnus-set-process-plist (process plist)
"Replace the plist of PROCESS with PLIST. Returns PLIST."
(put 'gnus-process-plist-internal process plist))
(defun gnus-process-plist (process)
"Return the plist of PROCESS."
;; This form works but can't prevent the plist data from
;; growing infinitely.
;;(get 'gnus-process-plist-internal process)
(let* ((plist (symbol-plist 'gnus-process-plist-internal))
(tem (memq process plist)))
(prog1
(cadr tem)
;; Remove it from the plist data.
(when tem
(if (eq plist tem)
(progn
(setcar plist (caddr plist))
(setcdr plist (or (cdddr plist) '(nil))))
(setcdr (nthcdr (- (length plist) (length tem) 1) plist)
(cddr tem)))))))
(defun gnus-process-get (process propname)
"Return the value of PROCESS' PROPNAME property.
This is the last value stored with `(gnus-process-put PROCESS PROPNAME VALUE)'."
(plist-get (gnus-process-plist process) propname))
(defun gnus-process-put (process propname value)
"Change PROCESS' PROPNAME property to VALUE.
It can be retrieved with `(gnus-process-get PROCESS PROPNAME)'."
(gnus-set-process-plist process
(plist-put (gnus-process-plist process)
propname value)))))
(provide 'gnus-ems)
;;; gnus-ems.el ends here

917
lisp/gnus/gnus-sync.el
View file

@ -1,917 +0,0 @@
;;; gnus-sync.el --- synchronization facility for Gnus
;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: news synchronization nntp nnrss
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This is the gnus-sync.el package.
;; Put this in your startup file (~/.gnus.el for instance)
;; possibilities for gnus-sync-backend:
;; Tramp over SSH: /ssh:user@host:/path/to/filename
;; ...or any other file Tramp and Emacs can handle...
;; (setq gnus-sync-backend "/remote:/path.gpg" ; will use Tramp+EPA if loaded
;; gnus-sync-global-vars '(gnus-newsrc-last-checked-date)
;; gnus-sync-newsrc-groups '("nntp" "nnrss"))
;; gnus-sync-newsrc-offsets '(2 3))
;; against a LeSync server (beware the vampire LeSync, who knows your newsrc)
;; (setq gnus-sync-backend '(lesync "http://lesync.info:5984/tzz")
;; gnus-sync-newsrc-groups '("nntp" "nnrss"))
;; What's a LeSync server?
;; 1. install CouchDB, set up a real server admin user, and create a
;; database, e.g. "tzz" and save the URL,
;; e.g. http://lesync.info:5984/tzz
;; 2. run `M-: (gnus-sync-lesync-setup "http://lesync.info:5984/tzz" "tzzadmin" "mypassword" "mysalt" t t)'
;; (If you run it more than once, you have to remove the entry from
;; _users yourself. This is intentional. This sets up a database
;; admin for the "tzz" database, distinct from the server admin
;; user in (1) above.)
;; That's it, you can start using http://lesync.info:5984/tzz in your
;; gnus-sync-backend as a LeSync backend. Fan fiction about the
;; vampire LeSync is welcome.
;; You may not want to expose a CouchDB install to the Big Bad
;; Internet, especially if your love of all things furry would be thus
;; revealed. Make sure it's not accessible by unauthorized users and
;; guests, at least.
;; If you want to try it out, I will create a test DB for you under
;; http://lesync.info:5984/yourfavoritedbname
;; TODO:
;; - after gnus-sync-read, the message counts look wrong until you do
;; `g'. So it's not run automatically, you have to call it with M-x
;; gnus-sync-read
;; - use gnus-after-set-mark-hook and gnus-before-update-mark-hook to
;; catch the mark updates
;; - repositioning of groups within topic after a LeSync sync is a
;; weird sort of bubble sort ("buttle" sort: the old entry ends up
;; at the rear of the list); you will eventually end up with the
;; right order after calling `gnus-sync-read' a bunch of times.
;; - installing topics and groups is inefficient and annoying, lots of
;; prompts could be avoided
;;; Code:
(eval-when-compile (require 'cl))
(require 'json)
(require 'gnus)
(require 'gnus-start)
(require 'gnus-util)
(defvar gnus-topic-alist) ;; gnus-group.el
(autoload 'gnus-group-topic "gnus-topic")
(defgroup gnus-sync nil
"The Gnus synchronization facility."
:version "24.1"
:group 'gnus)
(defcustom gnus-sync-newsrc-groups '("nntp" "nnrss")
"List of groups to be synchronized in the gnus-newsrc-alist.
The group names are matched, they don't have to be fully
qualified. Typically you would choose all of these. That's the
default because there is no active sync backend by default, so
this setting is harmless until the user chooses a sync backend."
:group 'gnus-sync
:type '(repeat regexp))
(defcustom gnus-sync-newsrc-offsets '(2 3)
"List of per-group data to be synchronized."
:group 'gnus-sync
:version "24.4"
:type '(set (const :tag "Read ranges" 2)
(const :tag "Marks" 3)))
(defcustom gnus-sync-global-vars nil
"List of global variables to be synchronized.
You may want to sync `gnus-newsrc-last-checked-date' but pretty
much any symbol is fair game. You could additionally sync
`gnus-newsrc-alist', `gnus-server-alist', `gnus-topic-topology',
and `gnus-topic-alist'. Also see `gnus-variable-list'."
:group 'gnus-sync
:type '(repeat (choice (variable :tag "A known variable")
(symbol :tag "Any symbol"))))
(defcustom gnus-sync-backend nil
"The synchronization backend."
:group 'gnus-sync
:type '(radio (const :format "None" nil)
(list :tag "Sync server"
(const :format "LeSync Server API" lesync)
(string :tag "URL of a CouchDB database for API access"))
(string :tag "Sync to a file")))
(defvar gnus-sync-newsrc-loader nil
"Carrier for newsrc data")
(defcustom gnus-sync-file-encrypt-to nil
"If non-nil, set `epa-file-encrypt-to' from this for encrypting the Sync file."
:version "24.4"
:type '(choice string (repeat string))
:group 'gnus-sync)
(defcustom gnus-sync-lesync-name (system-name)
"The LeSync name for this machine."
:group 'gnus-sync
:version "24.3"
:type 'string)
(defcustom gnus-sync-lesync-install-topics 'ask
"Should LeSync install the recorded topics?"
:group 'gnus-sync
:version "24.3"
:type '(choice (const :tag "Never Install" nil)
(const :tag "Always Install" t)
(const :tag "Ask Me Once" ask)))
(defvar gnus-sync-lesync-props-hash (make-hash-table :test 'equal)
"LeSync props, keyed by group name")
(defvar gnus-sync-lesync-design-prefix "/_design/lesync"
"The LeSync design prefix for CouchDB")
(defvar gnus-sync-lesync-security-object "/_security"
"The LeSync security object for CouchDB")
(defun gnus-sync-lesync-parse ()
"Parse the result of a LeSync request."
(goto-char (point-min))
(condition-case nil
(when (search-forward-regexp "^$" nil t)
(json-read))
(error
(gnus-message
1
"gnus-sync-lesync-parse: Could not read the LeSync response!")
nil)))
(defun gnus-sync-lesync-call (url method headers &optional kvdata)
"Make an access request to URL using KVDATA and METHOD.
KVDATA must be an alist."
(let ((url-request-method method)
(url-request-extra-headers headers)
(url-request-data (if kvdata (json-encode kvdata) nil)))
(with-current-buffer (url-retrieve-synchronously url)
(let ((data (gnus-sync-lesync-parse)))
(gnus-message 12 "gnus-sync-lesync-call: %s URL %s sent %S got %S"
method url `((headers . ,headers) (data ,kvdata)) data)
(kill-buffer (current-buffer))
data))))
(defun gnus-sync-lesync-PUT (url headers &optional data)
(gnus-sync-lesync-call url "PUT" headers data))
(defun gnus-sync-lesync-POST (url headers &optional data)
(gnus-sync-lesync-call url "POST" headers data))
(defun gnus-sync-lesync-GET (url headers &optional data)
(gnus-sync-lesync-call url "GET" headers data))
(defun gnus-sync-lesync-DELETE (url headers &optional data)
(gnus-sync-lesync-call url "DELETE" headers data))
;; this is not necessary with newer versions of json.el but 1.2 or older
;; (which are in Emacs 24.1 and earlier) need it
(defun gnus-sync-json-alist-p (list)
"Non-null if and only if LIST is an alist."
(while (consp list)
(setq list (if (consp (car list))
(cdr list)
'not-alist)))
(null list))
;; this is not necessary with newer versions of json.el but 1.2 or older
;; (which are in Emacs 24.1 and earlier) need it
(defun gnus-sync-json-plist-p (list)
"Non-null if and only if LIST is a plist."
(while (consp list)
(setq list (if (and (keywordp (car list))
(consp (cdr list)))
(cddr list)
'not-plist)))
(null list))
; (gnus-sync-lesync-setup "http://lesync.info:5984/tzz" "tzzadmin" "mypassword" "mysalt" t t)
; (gnus-sync-lesync-setup "http://lesync.info:5984/tzz")
(defun gnus-sync-lesync-setup (url &optional user password salt reader admin)
(interactive "sEnter URL to set up: ")
"Set up the LeSync database at URL.
Install USER as a READER and/or an ADMIN in the security object
under \"_security\", and in the CouchDB \"_users\" table using
PASSWORD and SALT. Only one USER is thus supported for now.
When SALT is nil, a random one will be generated using `random'."
(let* ((design-url (concat url gnus-sync-lesync-design-prefix))
(security-object (concat url "/_security"))
(user-record `((names . [,user]) (roles . [])))
(couch-user-name (format "org.couchdb.user:%s" user))
(salt (or salt (sha1 (format "%s" (random)))))
(couch-user-record
`((_id . ,couch-user-name)
(type . user)
(name . ,(format "%s" user))
(roles . [])
(salt . ,salt)
(password_sha . ,(when password
(sha1
(format "%s%s" password salt))))))
(rev (progn
(gnus-sync-lesync-find-prop 'rev design-url design-url)
(gnus-sync-lesync-get-prop 'rev design-url)))
(latest-func "function(head,req)
{
var tosend = [];
var row;
var ftime = (req.query['ftime'] || 0);
while (row = getRow())
{
if (row.value['float-time'] > ftime)
{
var s = row.value['_id'];
if (s) tosend.push('\"'+s.replace('\"', '\\\"')+'\"');
}
}
send('['+tosend.join(',') + ']');
}")
;; <key>read</key>
;; <dict>
;; <key>de.alt.fan.ipod</key>
;; <array>
;; <integer>1</integer>
;; <integer>2</integer>
;; <dict>
;; <key>start</key>
;; <integer>100</integer>
;; <key>length</key>
;; <integer>100</integer>
;; </dict>
;; </array>
;; </dict>
(xmlplistread-func "function(head, req) {
var row;
start({ 'headers': { 'Content-Type': 'text/xml' } });
send('<dict>');
send('<key>read</key>');
send('<dict>');
while(row = getRow())
{
var read = row.value.read;
if (read && read[0] && read[0] == 'invlist')
{
send('<key>'+row.key+'</key>');
//send('<invlist>'+read+'</invlist>');
send('<array>');
var from = 0;
var flip = false;
for (var i = 1; i < read.length && read[i]; i++)
{
var cur = read[i];
if (flip)
{
if (from == cur-1)
{
send('<integer>'+read[i]+'</integer>');
}
else
{
send('<dict>');
send('<key>start</key>');
send('<integer>'+from+'</integer>');
send('<key>end</key>');
send('<integer>'+(cur-1)+'</integer>');
send('</dict>');
}
}
flip = ! flip;
from = cur;
}
send('</array>');
}
}
send('</dict>');
send('</dict>');
}
")
(subs-func "function(doc){emit([doc._id, doc.source], doc._rev);}")
(revs-func "function(doc){emit(doc._id, doc._rev);}")
(bytimesubs-func "function(doc)
{emit([(doc['float-time']||0), doc._id], doc._rev);}")
(bytime-func "function(doc)
{emit([(doc['float-time']||0), doc._id], doc);}")
(groups-func "function(doc){emit(doc._id, doc);}"))
(and (if user
(and (assq 'ok (gnus-sync-lesync-PUT
security-object
nil
(append (and reader
(list `(readers . ,user-record)))
(and admin
(list `(admins . ,user-record))))))
(assq 'ok (gnus-sync-lesync-PUT
(concat (file-name-directory url)
"_users/"
couch-user-name)
nil
couch-user-record)))
t)
(assq 'ok (gnus-sync-lesync-PUT
design-url
nil
`(,@(when rev (list (cons '_rev rev)))
(lists . ((latest . ,latest-func)
(xmlplistread . ,xmlplistread-func)))
(views . ((subs . ((map . ,subs-func)))
(revs . ((map . ,revs-func)))
(bytimesubs . ((map . ,bytimesubs-func)))
(bytime . ((map . ,bytime-func)))
(groups . ((map . ,groups-func)))))))))))
(defun gnus-sync-lesync-find-prop (prop url key)
"Retrieve a PROPerty of a document KEY at URL.
Calls `gnus-sync-lesync-set-prop'.
For the 'rev PROP, uses '_rev against the document."
(gnus-sync-lesync-set-prop
prop key (cdr (assq (if (eq prop 'rev) '_rev prop)
(gnus-sync-lesync-GET url nil)))))
(defun gnus-sync-lesync-set-prop (prop key val)
"Update the PROPerty of document KEY at URL to VAL.
Updates `gnus-sync-lesync-props-hash'."
(puthash (format "%s.%s" key prop) val gnus-sync-lesync-props-hash))
(defun gnus-sync-lesync-get-prop (prop key)
"Get the PROPerty of KEY from `gnus-sync-lesync-props-hash'."
(gethash (format "%s.%s" key prop) gnus-sync-lesync-props-hash))
(defun gnus-sync-deep-print (data)
(let* ((print-quoted t)
(print-readably t)
(print-escape-multibyte nil)
(print-escape-nonascii t)
(print-length nil)
(print-level nil)
(print-circle nil)
(print-escape-newlines t))
(format "%S" data)))
(defun gnus-sync-newsrc-loader-builder (&optional only-modified)
(let* ((entries (cdr gnus-newsrc-alist))
entry name ret)
(while entries
(setq entry (pop entries)
name (car entry))
(when (gnus-grep-in-list name gnus-sync-newsrc-groups)
(if only-modified
(when (not (equal (gnus-sync-deep-print entry)
(gnus-sync-lesync-get-prop 'checksum name)))
(gnus-message 9 "%s: add %s, it's modified"
"gnus-sync-newsrc-loader-builder" name)
(push entry ret))
(push entry ret))))
ret))
; (json-encode (gnus-sync-range2invlist '((1 . 47137) (47139 . 47714) 48129 48211 49231 49281 49342 49473 49475 49502)))
(defun gnus-sync-range2invlist (ranges)
(append '(invlist)
(let ((ranges (delq nil ranges))
ret range from to)
(while ranges
(setq range (pop ranges))
(if (atom range)
(setq from range
to range)
(setq from (car range)
to (cdr range)))
(push from ret)
(push (1+ to) ret))
(reverse ret))))
; (let* ((d '((1 . 47137) (47139 . 47714) 48129 48211 49231 49281 49342 49473 49475 49502)) (j (format "%S" (gnus-sync-invlist2range (gnus-sync-range2invlist d))))) (or (equal (format "%S" d) j) j))
(defun gnus-sync-invlist2range (inv)
(setq inv (append inv nil))
(if (equal (format "%s" (car inv)) "invlist")
(let ((i (cdr inv))
(start 0)
ret cur top flip)
(while i
(setq cur (pop i))
(when flip
(setq top (1- cur))
(if (= start top)
(push start ret)
(push (cons start top) ret)))
(setq flip (not flip))
(setq start cur))
(reverse ret))
inv))
(defun gnus-sync-position (search list &optional test)
"Find the position of SEARCH in LIST using TEST, defaulting to `eq'."
(let ((pos 0)
(test (or test 'eq)))
(while (and list (not (funcall test (car list) search)))
(pop list)
(incf pos))
(if (funcall test (car list) search) pos nil)))
(defun gnus-sync-topic-group-position (group topic-name)
(gnus-sync-position
group (cdr (assoc topic-name gnus-topic-alist)) 'equal))
(defun gnus-sync-fix-topic-group-position (group topic-name position)
(unless (equal position (gnus-sync-topic-group-position group topic-name))
(let* ((loc "gnus-sync-fix-topic-group-position")
(groups (delete group (cdr (assoc topic-name gnus-topic-alist))))
(position (min position (1- (length groups))))
(old (nth position groups)))
(when (and old (not (equal old group)))
(setf (nth position groups) group)
(setcdr (assoc topic-name gnus-topic-alist)
(append groups (list old)))
(gnus-message 9 "%s: %s moved to %d, swap with %s"
loc group position old)))))
(defun gnus-sync-lesync-pre-save-group-entry (url nentry &rest passed-props)
(let* ((loc "gnus-sync-lesync-save-group-entry")
(k (car nentry))
(revision (gnus-sync-lesync-get-prop 'rev k))
(sname gnus-sync-lesync-name)
(topic (gnus-group-topic k))
(topic-offset (gnus-sync-topic-group-position k topic))
(sources (gnus-sync-lesync-get-prop 'source k)))
;; set the revision so we don't have a conflict
`(,@(when revision
(list (cons '_rev revision)))
(_id . ,k)
;; the time we saved
,@passed-props
;; add our name to the sources list for this key
(source ,@(if (member gnus-sync-lesync-name sources)
sources
(cons gnus-sync-lesync-name sources)))
,(cons 'level (nth 1 nentry))
,@(if topic (list (cons 'topic topic)) nil)
,@(if topic-offset (list (cons 'topic-offset topic-offset)) nil)
;; the read marks
,(cons 'read (gnus-sync-range2invlist (nth 2 nentry)))
;; the other marks
,@(delq nil (mapcar (lambda (mark-entry)
(gnus-message 12 "%s: prep param %s in %s"
loc
(car mark-entry)
(nth 3 nentry))
(if (listp (cdr mark-entry))
(cons (car mark-entry)
(gnus-sync-range2invlist
(cdr mark-entry)))
(progn ; else this is not a list
(gnus-message 9 "%s: non-list param %s in %s"
loc
(car mark-entry)
(nth 3 nentry))
nil)))
(nth 3 nentry))))))
(defun gnus-sync-lesync-post-save-group-entry (url entry)
(let* ((loc "gnus-sync-lesync-post-save-group-entry")
(k (cdr (assq 'id entry))))
(cond
;; success!
((and (assq 'rev entry) (assq 'id entry))
(progn
(gnus-sync-lesync-set-prop 'rev k (cdr (assq 'rev entry)))
(gnus-sync-lesync-set-prop 'checksum
k
(gnus-sync-deep-print
(assoc k gnus-newsrc-alist)))
(gnus-message 9 "%s: successfully synced %s to %s"
loc k url)))
;; specifically check for document conflicts
((equal "conflict" (format "%s" (cdr-safe (assq 'error entry))))
(gnus-error
1
"%s: use `%s' to resolve the conflict synchronizing %s to %s: %s"
loc "gnus-sync-read" k url (cdr (assq 'reason entry))))
;; generic errors
((assq 'error entry)
(gnus-error 1 "%s: got error while synchronizing %s to %s: %s"
loc k url (cdr (assq 'reason entry))))
(t
(gnus-message 2 "%s: unknown sync status after %s to %s: %S"
loc k url entry)))
(assoc 'error entry)))
(defun gnus-sync-lesync-groups-builder (url)
(let ((u (concat url gnus-sync-lesync-design-prefix "/_view/groups")))
(cdr (assq 'rows (gnus-sync-lesync-GET u nil)))))
(defun gnus-sync-subscribe-group (name)
"Subscribe to group NAME. Returns NAME on success, nil otherwise."
(gnus-subscribe-newsgroup name))
(defun gnus-sync-lesync-read-group-entry (url name entry &rest passed-props)
"Read ENTRY information for NAME. Returns NAME if successful.
Skips entries whose sources don't contain
`gnus-sync-lesync-name'. When the alist PASSED-PROPS has a
`subscribe-all' element that evaluates to true, we attempt to
subscribe to unknown groups. The user is also allowed to delete
unwanted groups via the LeSync URL."
(let* ((loc "gnus-sync-lesync-read-group-entry")
(entry (gnus-sync-lesync-normalize-group-entry entry passed-props))
(subscribe-all (cdr (assq 'subscribe-all passed-props)))
(sources (cdr (assq 'source entry)))
(rev (cdr (assq 'rev entry)))
(in-sources (member gnus-sync-lesync-name sources))
(known (assoc name gnus-newsrc-alist))
cell)
(unless known
(if (and subscribe-all
(y-or-n-p (format "Subscribe to group %s?" name)))
(setq known (gnus-sync-subscribe-group name)
in-sources t)
;; else...
(when (y-or-n-p (format "Delete group %s from server?" name))
(if (equal name (gnus-sync-lesync-delete-group url name))
(gnus-message 1 "%s: removed group %s from server %s"
loc name url)
(gnus-error 1 "%s: could not remove group %s from server %s"
loc name url)))))
(when known
(unless in-sources
(setq in-sources
(y-or-n-p
(format "Read group %s even though %s is not in sources %S?"
name gnus-sync-lesync-name (or sources ""))))))
(when rev
(gnus-sync-lesync-set-prop 'rev name rev))
;; if the source matches AND we have this group
(if (and known in-sources)
(progn
(gnus-message 10 "%s: reading LeSync entry %s, sources %S"
loc name sources)
(while entry
(setq cell (pop entry))
(let ((k (car cell))
(val (cdr cell)))
(gnus-sync-lesync-set-prop k name val)))
name)
;; else...
(unless known
(gnus-message 5 "%s: ignoring entry %s, it wasn't subscribed. %s"
loc name "Call `gnus-sync-read' with C-u to force it."))
(unless in-sources
(gnus-message 5 "%s: ignoring entry %s, %s not in sources %S"
loc name gnus-sync-lesync-name (or sources "")))
nil)))
(declare-function gnus-topic-create-topic "gnus-topic"
(topic parent &optional previous full-topic))
(declare-function gnus-topic-enter-dribble "gnus-topic" ())
(defun gnus-sync-lesync-install-group-entry (name)
(let* ((master (assoc name gnus-newsrc-alist))
(old-topic-name (gnus-group-topic name))
(old-topic (assoc old-topic-name gnus-topic-alist))
(target-topic-name (gnus-sync-lesync-get-prop 'topic name))
(target-topic-offset (gnus-sync-lesync-get-prop 'topic-offset name))
(target-topic (assoc target-topic-name gnus-topic-alist))
(loc "gnus-sync-lesync-install-group-entry"))
(if master
(progn
(when (eq 'ask gnus-sync-lesync-install-topics)
(setq gnus-sync-lesync-install-topics
(y-or-n-p "Install topics from LeSync?")))
(when (and (eq t gnus-sync-lesync-install-topics)
target-topic-name)
(if (equal old-topic-name target-topic-name)
(gnus-message 12 "%s: %s is already in topic %s"
loc name target-topic-name)
;; see `gnus-topic-move-group'
(when (and old-topic target-topic)
(setcdr old-topic (gnus-delete-first name (cdr old-topic)))
(gnus-message 5 "%s: removing %s from topic %s"
loc name old-topic-name))
(unless target-topic
(when (y-or-n-p (format "Create missing topic %s?"
target-topic-name))
(gnus-topic-create-topic target-topic-name nil)
(setq target-topic (assoc target-topic-name
gnus-topic-alist))))
(if target-topic
(prog1
(nconc target-topic (list name))
(gnus-message 5 "%s: adding %s to topic %s"
loc name (car target-topic))
(gnus-topic-enter-dribble))
(gnus-error 2 "%s: LeSync group %s can't go in missing topic %s"
loc name target-topic-name)))
(when (and target-topic-offset target-topic)
(gnus-sync-fix-topic-group-position
name target-topic-name target-topic-offset)))
;; install the subscription level
(when (gnus-sync-lesync-get-prop 'level name)
(setf (nth 1 master) (gnus-sync-lesync-get-prop 'level name)))
;; install the read and other marks
(setf (nth 2 master) (gnus-sync-lesync-get-prop 'read name))
(setf (nth 3 master) (gnus-sync-lesync-get-prop 'marks name))
(gnus-sync-lesync-set-prop 'checksum
name
(gnus-sync-deep-print master))
nil)
(gnus-error 1 "%s: invalid LeSync group %s" loc name)
'invalid-name)))
; (gnus-sync-lesync-delete-group (cdr gnus-sync-backend) "nntp+Gmane:gwene.org.slashdot")
(defun gnus-sync-lesync-delete-group (url name)
"Returns NAME if successful deleting it from URL, an error otherwise."
(interactive "sEnter URL to set up: \rsEnter group name: ")
(let* ((u (concat (cadr gnus-sync-backend) "/" (url-hexify-string name)))
(del (gnus-sync-lesync-DELETE
u
`(,@(when (gnus-sync-lesync-get-prop 'rev name)
(list (cons "If-Match"
(gnus-sync-lesync-get-prop 'rev name))))))))
(or (cdr (assq 'id del)) del)))
;;; (gnus-sync-lesync-normalize-group-entry '((subscribe . ["invlist"]) (read . ["invlist"]) (topic-offset . 20) (topic . "news") (level . 6) (source . ["a" "b"]) (float-time . 1319671237.099285) (_rev . "10-edf5107f41e5e6f7f6629d1c0ee172f7") (_id . "nntp+news.net:alt.movies")) '((read-time 1319672156.486414) (subscribe-all nil)))
(defun gnus-sync-lesync-normalize-group-entry (entry &optional passed-props)
(let (ret
marks
cell)
(setq entry (append passed-props entry))
(while (setq cell (pop entry))
(let ((k (car cell))
(val (cdr cell)))
(cond
((eq k 'read)
(push (cons k (gnus-sync-invlist2range val)) ret))
;; we ignore these parameters
((member k '(_id subscribe-all _deleted_conflicts))
nil)
((eq k '_rev)
(push (cons 'rev val) ret))
((eq k 'source)
(push (cons 'source (append val nil)) ret))
((or (eq k 'float-time)
(eq k 'level)
(eq k 'topic)
(eq k 'topic-offset)
(eq k 'read-time))
(push (cons k val) ret))
;;; "How often have I said to you that when you have eliminated the
;;; impossible, whatever remains, however improbable, must be the
;;; truth?" --Sherlock Holmes
;; everything remaining must be a mark
(t (push (cons k (gnus-sync-invlist2range val)) marks)))))
(cons (cons 'marks marks) ret)))
(defun gnus-sync-save (&optional force)
"Save the Gnus sync data to the backend.
With a prefix, FORCE is set and all groups will be saved."
(interactive "P")
(cond
((and (listp gnus-sync-backend)
(eq (nth 0 gnus-sync-backend) 'lesync)
(stringp (nth 1 gnus-sync-backend)))
;; refresh the revisions if we're forcing the save
(when force
(mapc (lambda (entry)
(when (and (assq 'key entry)
(assq 'value entry))
(gnus-sync-lesync-set-prop
'rev
(cdr (assq 'key entry))
(cdr (assq 'value entry)))))
;; the revs view is key = name, value = rev
(cdr (assq 'rows (gnus-sync-lesync-GET
(concat (nth 1 gnus-sync-backend)
gnus-sync-lesync-design-prefix
"/_view/revs")
nil)))))
(let* ((ftime (float-time))
(url (nth 1 gnus-sync-backend))
(entries
(mapcar (lambda (entry)
(gnus-sync-lesync-pre-save-group-entry
(cadr gnus-sync-backend)
entry
(cons 'float-time ftime)))
(gnus-sync-newsrc-loader-builder (not force))))
;; when there are no entries, there's nothing to save
(sync (if entries
(gnus-sync-lesync-POST
(concat url "/_bulk_docs")
'(("Content-Type" . "application/json"))
`((docs . ,(vconcat entries nil))))
(gnus-message
2 "gnus-sync-save: nothing to save to the LeSync backend")
nil)))
(mapcar (lambda (e) (gnus-sync-lesync-post-save-group-entry url e))
sync)))
((stringp gnus-sync-backend)
(gnus-message 7 "gnus-sync-save: saving to backend %s" gnus-sync-backend)
;; populate gnus-sync-newsrc-loader from all but the first dummy
;; entry in gnus-newsrc-alist whose group matches any of the
;; gnus-sync-newsrc-groups
;; TODO: keep the old contents for groups we don't have!
(let ((gnus-sync-newsrc-loader
(loop for entry in (cdr gnus-newsrc-alist)
when (gnus-grep-in-list
(car entry) ;the group name
gnus-sync-newsrc-groups)
collect (cons (car entry)
(mapcar (lambda (offset)
(cons offset (nth offset entry)))
gnus-sync-newsrc-offsets)))))
(with-temp-file gnus-sync-backend
(progn
(let ((coding-system-for-write gnus-ding-file-coding-system)
(standard-output (current-buffer)))
(when gnus-sync-file-encrypt-to
(set (make-local-variable 'epa-file-encrypt-to)
gnus-sync-file-encrypt-to))
(princ (format ";; -*- mode:emacs-lisp; coding: %s; -*-\n"
gnus-ding-file-coding-system))
(princ ";; Gnus sync data v. 0.0.1\n")
;; TODO: replace with `gnus-sync-deep-print'
(let* ((print-quoted t)
(print-readably t)
(print-escape-multibyte nil)
(print-escape-nonascii t)
(print-length nil)
(print-level nil)
(print-circle nil)
(print-escape-newlines t)
(variables (cons 'gnus-sync-newsrc-loader
gnus-sync-global-vars))
variable)
(while variables
(if (and (boundp (setq variable (pop variables)))
(symbol-value variable))
(progn
(princ "\n(setq ")
(princ (symbol-name variable))
(princ " '")
(prin1 (symbol-value variable))
(princ ")\n"))
(princ "\n;;; skipping empty variable ")
(princ (symbol-name variable)))))
(gnus-message
7
"gnus-sync-save: stored variables %s and %d groups in %s"
gnus-sync-global-vars
(length gnus-sync-newsrc-loader)
gnus-sync-backend)
;; Idea from Dan Christensen <jdc@chow.mat.jhu.edu>
;; Save the .eld file with extra line breaks.
(gnus-message 8 "gnus-sync-save: adding whitespace to %s"
gnus-sync-backend)
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^(\\|(\\\"" nil t)
(replace-match "\n\\&" t))
(goto-char (point-min))
(while (re-search-forward " $" nil t)
(replace-match "" t t))))))))
;; the pass-through case: gnus-sync-backend is not a known choice
(nil)))
(defun gnus-sync-read (&optional subscribe-all)
"Load the Gnus sync data from the backend.
With a prefix, SUBSCRIBE-ALL is set and unknown groups will be subscribed."
(interactive "P")
(when gnus-sync-backend
(gnus-message 7 "gnus-sync-read: loading from backend %s" gnus-sync-backend)
(cond
((and (listp gnus-sync-backend)
(eq (nth 0 gnus-sync-backend) 'lesync)
(stringp (nth 1 gnus-sync-backend)))
(let ((errored nil)
name ftime)
(mapc (lambda (entry)
(setq name (cdr (assq 'id entry)))
;; set ftime the FIRST time through this loop, that
;; way it reflects the time we FINISHED reading
(unless ftime (setq ftime (float-time)))
(unless errored
(setq errored
(when (equal name
(gnus-sync-lesync-read-group-entry
(nth 1 gnus-sync-backend)
name
(cdr (assq 'value entry))
`(read-time ,ftime)
`(subscribe-all ,subscribe-all)))
(gnus-sync-lesync-install-group-entry
(cdr (assq 'id entry)))))))
(gnus-sync-lesync-groups-builder (nth 1 gnus-sync-backend)))))
((stringp gnus-sync-backend)
;; read data here...
(if (or debug-on-error debug-on-quit)
(load gnus-sync-backend nil t)
(condition-case var
(load gnus-sync-backend nil t)
(error
(error "Error in %s: %s" gnus-sync-backend (cadr var)))))
(let ((valid-count 0)
invalid-groups)
(dolist (node gnus-sync-newsrc-loader)
(if (gnus-gethash (car node) gnus-newsrc-hashtb)
(progn
(incf valid-count)
(loop for store in (cdr node)
do (setf (nth (car store)
(assoc (car node) gnus-newsrc-alist))
(cdr store))))
(push (car node) invalid-groups)))
(gnus-message
7
"gnus-sync-read: loaded %d groups (out of %d) from %s"
valid-count (length gnus-sync-newsrc-loader)
gnus-sync-backend)
(when invalid-groups
(gnus-message
7
"gnus-sync-read: skipped %d groups (out of %d) from %s"
(length invalid-groups)
(length gnus-sync-newsrc-loader)
gnus-sync-backend)
(gnus-message 9 "gnus-sync-read: skipped groups: %s"
(mapconcat 'identity invalid-groups ", ")))))
(nil))
(gnus-message 9 "gnus-sync-read: remaking the newsrc hashtable")
(gnus-make-hashtable-from-newsrc-alist)))
;;;###autoload
(defun gnus-sync-initialize ()
"Initialize the Gnus sync facility."
(interactive)
(gnus-message 5 "Initializing the sync facility")
(gnus-sync-install-hooks))
;;;###autoload
(defun gnus-sync-install-hooks ()
"Install the sync hooks."
(interactive)
;; (add-hook 'gnus-get-new-news-hook 'gnus-sync-read)
;; (add-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read)
(add-hook 'gnus-save-newsrc-hook 'gnus-sync-save))
(defun gnus-sync-unload-hook ()
"Uninstall the sync hooks."
(interactive)
(remove-hook 'gnus-save-newsrc-hook 'gnus-sync-save))
(add-hook 'gnus-sync-unload-hook 'gnus-sync-unload-hook)
(when gnus-sync-backend (gnus-sync-initialize))
(provide 'gnus-sync)
;;; gnus-sync.el ends here

91
lisp/gnus/messcompat.el
View file

@ -1,91 +0,0 @@
;;; messcompat.el --- making message mode compatible with mail mode
;; Copyright (C) 1996-2017 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: mail, news
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This file tries to provide backward compatibility with sendmail.el
;; for Message mode. It should be used by simply adding
;;
;; (require 'messcompat)
;;
;; to the .emacs file. Loading it after Message mode has been
;; loaded will have no effect.
;;; Code:
(require 'sendmail)
(defvar message-from-style mail-from-style
"*Specifies how \"From\" headers look.
If nil, they contain just the return address like:
king@grassland.com
If `parens', they look like:
king@grassland.com (Elvis Parsley)
If `angles', they look like:
Elvis Parsley <king@grassland.com>
Otherwise, most addresses look like `angles', but they look like
`parens' if `angles' would need quoting and `parens' would not.")
(defvar message-interactive mail-interactive
"Non-nil means when sending a message wait for and display errors.
nil means let mailer mail back a message to report errors.")
(defvar message-setup-hook mail-setup-hook
"Normal hook, run each time a new outgoing message is initialized.
The function `message-setup' runs this hook.")
(if (boundp 'mail-mode-hook)
(defvar message-mode-hook mail-mode-hook
"Hook run in message mode buffers."))
(defvar message-indentation-spaces mail-indentation-spaces
"*Number of spaces to insert at the beginning of each cited line.
Used by `message-yank-original' via `message-yank-cite'.")
(defvar message-signature mail-signature
"*String to be inserted at the end of the message buffer.
If t, the `message-signature-file' file will be inserted instead.
If a function, the result from the function will be used instead.
If a form, the result from the form will be used instead.")
;; Deleted the autoload cookie because this crashes in loaddefs.el.
(defvar message-signature-file mail-signature-file
"*File containing the text inserted at end of the message buffer.")
(defvar message-default-headers mail-default-headers
"*A string containing header lines to be inserted in outgoing messages.
It is inserted before you edit the message, so you can edit or delete
these lines.")
(defvar message-send-hook mail-send-hook
"Hook run before sending messages.")
(defvar message-send-mail-function send-mail-function
"Function to call to send the current buffer as mail.
The headers should be delimited by a line whose contents match the
variable `mail-header-separator'.")
(provide 'messcompat)
;;; messcompat.el ends here

423
lisp/nxml/nxml-glyph.el
View file

@ -1,423 +0,0 @@
;;; nxml-glyph.el --- glyph-handling for nxml-mode
;; Copyright (C) 2003, 2007-2017 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: wp, hypermedia, languages, XML
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; The entry point to this file is `nxml-glyph-display-string'.
;; The current implementation is heuristic due to a lack of
;; Emacs primitives necessary to implement it properly. The user
;; can tweak the heuristics using `nxml-glyph-set-functions'.
;;; Code:
(defconst nxml-ascii-glyph-set
[(#x0020 . #x007E)])
(defconst nxml-latin1-glyph-set
[(#x0020 . #x007E)
(#x00A0 . #x00FF)])
;; These were generated by using nxml-insert-target-repertoire-glyph-set
;; on the TARGET[123] files in
;; http://www.cl.cam.ac.uk/~mgk25/download/ucs-fonts.tar.gz
(defconst nxml-misc-fixed-1-glyph-set
[(#x0020 . #x007E)
(#x00A0 . #x00FF)
(#x0100 . #x017F)
#x018F #x0192
(#x0218 . #x021B)
#x0259
(#x02C6 . #x02C7)
(#x02D8 . #x02DD)
(#x0374 . #x0375)
#x037A #x037E
(#x0384 . #x038A)
#x038C
(#x038E . #x03A1)
(#x03A3 . #x03CE)
(#x0401 . #x040C)
(#x040E . #x044F)
(#x0451 . #x045C)
(#x045E . #x045F)
(#x0490 . #x0491)
(#x05D0 . #x05EA)
(#x1E02 . #x1E03)
(#x1E0A . #x1E0B)
(#x1E1E . #x1E1F)
(#x1E40 . #x1E41)
(#x1E56 . #x1E57)
(#x1E60 . #x1E61)
(#x1E6A . #x1E6B)
(#x1E80 . #x1E85)
(#x1EF2 . #x1EF3)
(#x2010 . #x2022)
#x2026 #x2030
(#x2039 . #x203A)
#x20AC #x2116 #x2122 #x2126
(#x215B . #x215E)
(#x2190 . #x2193)
#x2260
(#x2264 . #x2265)
(#x23BA . #x23BD)
(#x2409 . #x240D)
#x2424 #x2500 #x2502 #x250C #x2510 #x2514 #x2518 #x251C #x2524 #x252C #x2534 #x253C #x2592 #x25C6 #x266A #xFFFD]
"Glyph set for TARGET1 glyph repertoire of misc-fixed-* font.
This repertoire is supported for the bold and oblique fonts.")
(defconst nxml-misc-fixed-2-glyph-set
[(#x0020 . #x007E)
(#x00A0 . #x00FF)
(#x0100 . #x017F)
#x018F #x0192
(#x01FA . #x01FF)
(#x0218 . #x021B)
#x0259
(#x02C6 . #x02C7)
#x02C9
(#x02D8 . #x02DD)
(#x0300 . #x0311)
(#x0374 . #x0375)
#x037A #x037E
(#x0384 . #x038A)
#x038C
(#x038E . #x03A1)
(#x03A3 . #x03CE)
#x03D1
(#x03D5 . #x03D6)
#x03F1
(#x0401 . #x040C)
(#x040E . #x044F)
(#x0451 . #x045C)
(#x045E . #x045F)
(#x0490 . #x0491)
(#x05D0 . #x05EA)
(#x1E02 . #x1E03)
(#x1E0A . #x1E0B)
(#x1E1E . #x1E1F)
(#x1E40 . #x1E41)
(#x1E56 . #x1E57)
(#x1E60 . #x1E61)
(#x1E6A . #x1E6B)
(#x1E80 . #x1E85)
(#x1EF2 . #x1EF3)
(#x2010 . #x2022)
#x2026 #x2030
(#x2032 . #x2034)
(#x2039 . #x203A)
#x203C #x203E #x2044
(#x2070 . #x2071)
(#x2074 . #x208E)
(#x20A3 . #x20A4)
#x20A7 #x20AC
(#x20D0 . #x20D7)
#x2102 #x2105 #x2113
(#x2115 . #x2116)
#x211A #x211D #x2122 #x2124 #x2126 #x212E
(#x215B . #x215E)
(#x2190 . #x2195)
(#x21A4 . #x21A8)
(#x21D0 . #x21D5)
(#x2200 . #x2209)
(#x220B . #x220C)
#x220F
(#x2211 . #x2213)
#x2215
(#x2218 . #x221A)
(#x221D . #x221F)
#x2221
(#x2224 . #x222B)
#x222E #x223C #x2243 #x2245
(#x2248 . #x2249)
#x2259
(#x225F . #x2262)
(#x2264 . #x2265)
(#x226A . #x226B)
(#x2282 . #x228B)
#x2295 #x2297
(#x22A4 . #x22A7)
(#x22C2 . #x22C3)
#x22C5 #x2300 #x2302
(#x2308 . #x230B)
#x2310
(#x2320 . #x2321)
(#x2329 . #x232A)
(#x23BA . #x23BD)
(#x2409 . #x240D)
#x2424 #x2500 #x2502 #x250C #x2510 #x2514 #x2518 #x251C #x2524 #x252C #x2534 #x253C
(#x254C . #x2573)
(#x2580 . #x25A1)
(#x25AA . #x25AC)
(#x25B2 . #x25B3)
#x25BA #x25BC #x25C4 #x25C6
(#x25CA . #x25CB)
#x25CF
(#x25D8 . #x25D9)
#x25E6
(#x263A . #x263C)
#x2640 #x2642 #x2660 #x2663
(#x2665 . #x2666)
(#x266A . #x266B)
(#xFB01 . #xFB02)
#xFFFD]
"Glyph set for TARGET2 glyph repertoire of the misc-fixed-* fonts.
This repertoire is supported for the following fonts:
5x7.bdf 5x8.bdf 6x9.bdf 6x10.bdf 6x12.bdf 7x13.bdf 7x14.bdf clR6x12.bdf")
(defconst nxml-misc-fixed-3-glyph-set
[(#x0020 . #x007E)
(#x00A0 . #x00FF)
(#x0100 . #x01FF)
(#x0200 . #x0220)
(#x0222 . #x0233)
(#x0250 . #x02AD)
(#x02B0 . #x02EE)
(#x0300 . #x034F)
(#x0360 . #x036F)
(#x0374 . #x0375)
#x037A #x037E
(#x0384 . #x038A)
#x038C
(#x038E . #x03A1)
(#x03A3 . #x03CE)
(#x03D0 . #x03F6)
(#x0400 . #x0486)
(#x0488 . #x04CE)
(#x04D0 . #x04F5)
(#x04F8 . #x04F9)
(#x0500 . #x050F)
(#x0531 . #x0556)
(#x0559 . #x055F)
(#x0561 . #x0587)
(#x0589 . #x058A)
(#x05B0 . #x05B9)
(#x05BB . #x05C4)
(#x05D0 . #x05EA)
(#x05F0 . #x05F4)
(#x10D0 . #x10F8)
#x10FB
(#x1E00 . #x1E9B)
(#x1EA0 . #x1EF9)
(#x1F00 . #x1F15)
(#x1F18 . #x1F1D)
(#x1F20 . #x1F45)
(#x1F48 . #x1F4D)
(#x1F50 . #x1F57)
#x1F59 #x1F5B #x1F5D
(#x1F5F . #x1F7D)
(#x1F80 . #x1FB4)
(#x1FB6 . #x1FC4)
(#x1FC6 . #x1FD3)
(#x1FD6 . #x1FDB)
(#x1FDD . #x1FEF)
(#x1FF2 . #x1FF4)
(#x1FF6 . #x1FFE)
(#x2000 . #x200A)
(#x2010 . #x2027)
(#x202F . #x2052)
#x2057
(#x205F . #x2063)
(#x2070 . #x2071)
(#x2074 . #x208E)
(#x20A0 . #x20B1)
(#x20D0 . #x20EA)
(#x2100 . #x213A)
(#x213D . #x214B)
(#x2153 . #x2183)
(#x2190 . #x21FF)
(#x2200 . #x22FF)
(#x2300 . #x23CE)
(#x2400 . #x2426)
(#x2440 . #x244A)
(#x2500 . #x25FF)
(#x2600 . #x2613)
(#x2616 . #x2617)
(#x2619 . #x267D)
(#x2680 . #x2689)
(#x27E6 . #x27EB)
(#x27F5 . #x27FF)
(#x2A00 . #x2A06)
#x2A1D #x2A3F #x303F
(#xFB00 . #xFB06)
(#xFB13 . #xFB17)
(#xFB1D . #xFB36)
(#xFB38 . #xFB3C)
#xFB3E
(#xFB40 . #xFB41)
(#xFB43 . #xFB44)
(#xFB46 . #xFB4F)
(#xFE20 . #xFE23)
(#xFF61 . #xFF9F)
#xFFFD]
"Glyph set for TARGET3 glyph repertoire of the misc-fixed-* fonts.
This repertoire is supported for the following fonts:
6x13.bdf 8x13.bdf 9x15.bdf 9x18.bdf 10x20.bdf")
(defconst nxml-wgl4-glyph-set
[(#x0020 . #x007E)
(#x00A0 . #x017F)
#x0192
(#x01FA . #x01FF)
(#x02C6 . #x02C7)
#x02C9
(#x02D8 . #x02DB)
#x02DD
(#x0384 . #x038A)
#x038C
(#x038E . #x03A1)
(#x03A3 . #x03CE)
(#x0401 . #x040C)
(#x040E . #x044F)
(#x0451 . #x045C)
(#x045E . #x045F)
(#x0490 . #x0491)
(#x1E80 . #x1E85)
(#x1EF2 . #x1EF3)
(#x2013 . #x2015)
(#x2017 . #x201E)
(#x2020 . #x2022)
#x2026 #x2030
(#x2032 . #x2033)
(#x2039 . #x203A)
#x203C #x203E #x2044 #x207F
(#x20A3 . #x20A4)
#x20A7 #x20AC #x2105 #x2113 #x2116 #x2122 #x2126 #x212E
(#x215B . #x215E)
(#x2190 . #x2195)
#x21A8 #x2202 #x2206 #x220F
(#x2211 . #x2212)
#x2215
(#x2219 . #x221A)
(#x221E . #x221F)
#x2229 #x222B #x2248
(#x2260 . #x2261)
(#x2264 . #x2265)
#x2302 #x2310
(#x2320 . #x2321)
#x2500 #x2502 #x250C #x2510 #x2514 #x2518 #x251C #x2524
#x252C #x2534 #x253C
(#x2550 . #x256C)
#x2580 #x2584 #x2588 #x258C
(#x2590 . #x2593)
(#x25A0 . #x25A1)
(#x25AA . #x25AC)
#x25B2 #x25BA #x25BC #x25C4
(#x25CA . #x25CB)
#x25CF
(#x25D8 . #x25D9)
#x25E6
(#x263A . #x263C)
#x2640 #x2642 #x2660 #x2663
(#x2665 . #x2666)
(#x266A . #x266B)
(#xFB01 . #xFB02)]
"Glyph set corresponding to Windows Glyph List 4.")
(defvar nxml-glyph-set-functions nil
"Abnormal hook for determining the set of glyphs in a face.
Each function in this hook is called in turn, unless one of them
returns non-nil. Each function is called with a single argument
FACE. If it can determine the set of glyphs representable by
FACE, it must set the variable `nxml-glyph-set' and return
non-nil. Otherwise, it must return nil.
The constants `nxml-ascii-glyph-set', `nxml-latin1-glyph-set',
`nxml-misc-fixed-1-glyph-set', `nxml-misc-fixed-2-glyph-set',
`nxml-misc-fixed-3-glyph-set' and `nxml-wgl4-glyph-set' are
predefined for use by `nxml-glyph-set-functions'.")
(define-obsolete-variable-alias 'nxml-glyph-set-hook
'nxml-glyph-set-functions "24.3")
(defvar nxml-glyph-set nil
"Used by `nxml-glyph-set-functions' to return set of glyphs in a FACE.
This should dynamically bound by any function that runs
`nxml-glyph-set-functions'. The value must be either nil representing an
empty set or a vector. Each member of the vector is either a single
integer or a cons (FIRST . LAST) representing the range of integers
from FIRST to LAST. An integer represents a glyph with that Unicode
code-point. The vector must be ordered.")
(defun nxml-x-set-glyph-set (face)
(setq nxml-glyph-set
(if (equal (face-attribute face :family) "misc-fixed")
nxml-misc-fixed-3-glyph-set
nxml-wgl4-glyph-set)))
(defun nxml-w32-set-glyph-set (face)
(setq nxml-glyph-set nxml-wgl4-glyph-set))
(defun nxml-window-system-set-glyph-set (face)
(setq nxml-glyph-set nxml-latin1-glyph-set))
(defun nxml-terminal-set-glyph-set (face)
(setq nxml-glyph-set nxml-ascii-glyph-set))
(add-hook 'nxml-glyph-set-functions
(or (cdr (assq window-system
'((x . nxml-x-set-glyph-set)
(w32 . nxml-w32-set-glyph-set)
(nil . nxml-terminal-set-glyph-set))))
'nxml-window-system-set-glyph-set)
t)
;;;###autoload
(defun nxml-glyph-display-string (n face)
"Return a string that can display a glyph for Unicode code-point N.
FACE gives the face that will be used for displaying the string.
Return nil if the face cannot display a glyph for N."
(let ((nxml-glyph-set nil))
(run-hook-with-args-until-success 'nxml-glyph-set-functions face)
(and nxml-glyph-set
(nxml-glyph-set-contains-p n nxml-glyph-set)
(let ((ch (decode-char 'ucs n)))
(and ch (string ch))))))
(defun nxml-glyph-set-contains-p (n v)
(let ((start 0)
(end (length v))
found mid mid-val mid-start-val mid-end-val)
(while (> end start)
(setq mid (+ start
(/ (- end start) 2)))
(setq mid-val (aref v mid))
(if (consp mid-val)
(setq mid-start-val (car mid-val)
mid-end-val (cdr mid-val))
(setq mid-start-val mid-val
mid-end-val mid-val))
(cond ((and (<= mid-start-val n)
(<= n mid-end-val))
(setq found t)
(setq start end))
((< n mid-start-val)
(setq end mid))
(t
(setq start
(if (eq start mid)
end
mid)))))
found))
(provide 'nxml-glyph)
;;; nxml-glyph.el ends here

251
lisp/nxml/nxml-uchnm.el
View file

@ -1,251 +0,0 @@
;;; nxml-uchnm.el --- support for Unicode standard cha names in nxml-mode
;; Copyright (C) 2003, 2007-2017 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: wp, hypermedia, languages, XML
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This enables the use of the character names defined in the Unicode
;; Standard. The use of the names can be controlled on a per-block
;; basis, so as both to reduce memory usage and loading time,
;; and to make completion work better.
;;; Code:
(require 'nxml-mode)
(defconst nxml-unicode-blocks
'(("Basic Latin" #x0000 #x007F)
("Latin-1 Supplement" #x0080 #x00FF)
("Latin Extended-A" #x0100 #x017F)
("Latin Extended-B" #x0180 #x024F)
("IPA Extensions" #x0250 #x02AF)
("Spacing Modifier Letters" #x02B0 #x02FF)
("Combining Diacritical Marks" #x0300 #x036F)
("Greek and Coptic" #x0370 #x03FF)
("Cyrillic" #x0400 #x04FF)
("Cyrillic Supplementary" #x0500 #x052F)
("Armenian" #x0530 #x058F)
("Hebrew" #x0590 #x05FF)
("Arabic" #x0600 #x06FF)
("Syriac" #x0700 #x074F)
("Thaana" #x0780 #x07BF)
("Devanagari" #x0900 #x097F)
("Bengali" #x0980 #x09FF)
("Gurmukhi" #x0A00 #x0A7F)
("Gujarati" #x0A80 #x0AFF)
("Oriya" #x0B00 #x0B7F)
("Tamil" #x0B80 #x0BFF)
("Telugu" #x0C00 #x0C7F)
("Kannada" #x0C80 #x0CFF)
("Malayalam" #x0D00 #x0D7F)
("Sinhala" #x0D80 #x0DFF)
("Thai" #x0E00 #x0E7F)
("Lao" #x0E80 #x0EFF)
("Tibetan" #x0F00 #x0FFF)
("Myanmar" #x1000 #x109F)
("Georgian" #x10A0 #x10FF)
("Hangul Jamo" #x1100 #x11FF)
("Ethiopic" #x1200 #x137F)
("Cherokee" #x13A0 #x13FF)
("Unified Canadian Aboriginal Syllabics" #x1400 #x167F)
("Ogham" #x1680 #x169F)
("Runic" #x16A0 #x16FF)
("Tagalog" #x1700 #x171F)
("Hanunoo" #x1720 #x173F)
("Buhid" #x1740 #x175F)
("Tagbanwa" #x1760 #x177F)
("Khmer" #x1780 #x17FF)
("Mongolian" #x1800 #x18AF)
("Latin Extended Additional" #x1E00 #x1EFF)
("Greek Extended" #x1F00 #x1FFF)
("General Punctuation" #x2000 #x206F)
("Superscripts and Subscripts" #x2070 #x209F)
("Currency Symbols" #x20A0 #x20CF)
("Combining Diacritical Marks for Symbols" #x20D0 #x20FF)
("Letterlike Symbols" #x2100 #x214F)
("Number Forms" #x2150 #x218F)
("Arrows" #x2190 #x21FF)
("Mathematical Operators" #x2200 #x22FF)
("Miscellaneous Technical" #x2300 #x23FF)
("Control Pictures" #x2400 #x243F)
("Optical Character Recognition" #x2440 #x245F)
("Enclosed Alphanumerics" #x2460 #x24FF)
("Box Drawing" #x2500 #x257F)
("Block Elements" #x2580 #x259F)
("Geometric Shapes" #x25A0 #x25FF)
("Miscellaneous Symbols" #x2600 #x26FF)
("Dingbats" #x2700 #x27BF)
("Miscellaneous Mathematical Symbols-A" #x27C0 #x27EF)
("Supplemental Arrows-A" #x27F0 #x27FF)
("Braille Patterns" #x2800 #x28FF)
("Supplemental Arrows-B" #x2900 #x297F)
("Miscellaneous Mathematical Symbols-B" #x2980 #x29FF)
("Supplemental Mathematical Operators" #x2A00 #x2AFF)
("CJK Radicals Supplement" #x2E80 #x2EFF)
("Kangxi Radicals" #x2F00 #x2FDF)
("Ideographic Description Characters" #x2FF0 #x2FFF)
("CJK Symbols and Punctuation" #x3000 #x303F)
("Hiragana" #x3040 #x309F)
("Katakana" #x30A0 #x30FF)
("Bopomofo" #x3100 #x312F)
("Hangul Compatibility Jamo" #x3130 #x318F)
("Kanbun" #x3190 #x319F)
("Bopomofo Extended" #x31A0 #x31BF)
("Katakana Phonetic Extensions" #x31F0 #x31FF)
("Enclosed CJK Letters and Months" #x3200 #x32FF)
("CJK Compatibility" #x3300 #x33FF)
("CJK Unified Ideographs Extension A" #x3400 #x4DBF)
;;("CJK Unified Ideographs" #x4E00 #x9FFF)
("Yi Syllables" #xA000 #xA48F)
("Yi Radicals" #xA490 #xA4CF)
;;("Hangul Syllables" #xAC00 #xD7AF)
;;("High Surrogates" #xD800 #xDB7F)
;;("High Private Use Surrogates" #xDB80 #xDBFF)
;;("Low Surrogates" #xDC00 #xDFFF)
;;("Private Use Area" #xE000 #xF8FF)
;;("CJK Compatibility Ideographs" #xF900 #xFAFF)
("Alphabetic Presentation Forms" #xFB00 #xFB4F)
("Arabic Presentation Forms-A" #xFB50 #xFDFF)
("Variation Selectors" #xFE00 #xFE0F)
("Combining Half Marks" #xFE20 #xFE2F)
("CJK Compatibility Forms" #xFE30 #xFE4F)
("Small Form Variants" #xFE50 #xFE6F)
("Arabic Presentation Forms-B" #xFE70 #xFEFF)
("Halfwidth and Fullwidth Forms" #xFF00 #xFFEF)
("Specials" #xFFF0 #xFFFF)
("Old Italic" #x10300 #x1032F)
("Gothic" #x10330 #x1034F)
("Deseret" #x10400 #x1044F)
("Byzantine Musical Symbols" #x1D000 #x1D0FF)
("Musical Symbols" #x1D100 #x1D1FF)
("Mathematical Alphanumeric Symbols" #x1D400 #x1D7FF)
;;("CJK Unified Ideographs Extension B" #x20000 #x2A6DF)
;;("CJK Compatibility Ideographs Supplement" #x2F800 #x2FA1F)
("Tags" #xE0000 #xE007F)
;;("Supplementary Private Use Area-A" #xF0000 #xFFFFF)
;;("Supplementary Private Use Area-B" #x100000 #x10FFFF)
)
"List of Unicode blocks.
For each block there is a list (NAME FIRST LAST), where
NAME is a string giving the official name of the block,
FIRST is the first code-point and LAST is the last code-point.
Blocks containing only characters with algorithmic names or no names
are omitted.")
(defun nxml-unicode-block-char-name-set (name)
"Return a symbol for a block whose official Unicode name is NAME.
The symbol is generated by downcasing and replacing each space
by a hyphen."
(intern (replace-regexp-in-string " " "-" (downcase name))))
;; This is intended to be a superset of the coverage
;; of existing standard entity sets.
(defvar nxml-enabled-unicode-blocks-default
'(basic-latin
latin-1-supplement
latin-extended-a
latin-extended-b
ipa-extensions
spacing-modifier-letters
combining-diacritical-marks
greek-and-coptic
cyrillic
general-punctuation
superscripts-and-subscripts
currency-symbols
combining-diacritical-marks-for-symbols
letterlike-symbols
number-forms
arrows
mathematical-operators
miscellaneous-technical
control-pictures
optical-character-recognition
enclosed-alphanumerics
box-drawing
block-elements
geometric-shapes
miscellaneous-symbols
dingbats
miscellaneous-mathematical-symbols-a
supplemental-arrows-a
supplemental-arrows-b
miscellaneous-mathematical-symbols-b
supplemental-mathematical-operators
cjk-symbols-and-punctuation
alphabetic-presentation-forms
variation-selectors
small-form-variants
specials
mathematical-alphanumeric-symbols)
"Default value for `nxml-enabled-unicode-blocks'.")
(mapc (lambda (block)
(nxml-autoload-char-name-set
(nxml-unicode-block-char-name-set (car block))
(expand-file-name
(format "nxml/%05X-%05X"
(nth 1 block)
(nth 2 block))
data-directory)))
nxml-unicode-blocks)
;; Internal flag to control whether customize reloads the character tables.
;; Should be set the first time the
(defvar nxml-internal-unicode-char-name-sets-enabled nil)
(defcustom nxml-enabled-unicode-blocks nxml-enabled-unicode-blocks-default
"List of Unicode blocks for which Unicode character names are enabled.
Each block is identified by a symbol derived from the name
of the block by downcasing and replacing each space by a hyphen."
:group 'nxml
:set (lambda (sym value)
(set-default 'nxml-enabled-unicode-blocks value)
(when nxml-internal-unicode-char-name-sets-enabled
(nxml-enable-unicode-char-name-sets)))
:type (cons 'set
(mapcar (lambda (block)
`(const :tag ,(format "%s (%04X-%04X)"
(nth 0 block)
(nth 1 block)
(nth 2 block))
,(nxml-unicode-block-char-name-set
(nth 0 block))))
nxml-unicode-blocks)))
;;;###autoload
(defun nxml-enable-unicode-char-name-sets ()
"Enable the use of Unicode standard names for characters.
The Unicode blocks for which names are enabled is controlled by
the variable `nxml-enabled-unicode-blocks'."
(interactive)
(setq nxml-internal-unicode-char-name-sets-enabled t)
(mapc (lambda (block)
(nxml-disable-char-name-set
(nxml-unicode-block-char-name-set (car block))))
nxml-unicode-blocks)
(mapc (lambda (nameset)
(nxml-enable-char-name-set nameset))
nxml-enabled-unicode-blocks))
(provide 'nxml-uchnm)
;;; nxml-uchnm.el ends here

124
lisp/obsolete/awk-mode.el
View file

@ -1,124 +0,0 @@
;;; awk-mode.el --- AWK code editing commands for Emacs
;; Copyright (C) 1988, 1994, 1996, 2000-2017 Free Software Foundation,
;; Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: unix, languages
;; Obsolete-since: 22.1
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Sets up C-mode with support for awk-style #-comments and a lightly
;; hacked syntax table.
;;; Code:
(defvar awk-mode-syntax-table
(let ((st (make-syntax-table)))
(modify-syntax-entry ?\\ "\\" st)
(modify-syntax-entry ?\n "> " st)
(modify-syntax-entry ?\f "> " st)
(modify-syntax-entry ?\# "< " st)
;; / can delimit regexes or be a division operator. We assume that it is
;; more commonly used for regexes and fix the remaining cases with
;; `font-lock-syntactic-keywords'.
(modify-syntax-entry ?/ "\"" st)
(modify-syntax-entry ?* "." st)
(modify-syntax-entry ?+ "." st)
(modify-syntax-entry ?- "." st)
(modify-syntax-entry ?= "." st)
(modify-syntax-entry ?% "." st)
(modify-syntax-entry ?< "." st)
(modify-syntax-entry ?> "." st)
(modify-syntax-entry ?& "." st)
(modify-syntax-entry ?| "." st)
(modify-syntax-entry ?_ "_" st)
(modify-syntax-entry ?\' "\"" st)
st)
"Syntax table in use in `awk-mode' buffers.")
;; Regexps written with help from Peter Galbraith <galbraith@mixing.qc.dfo.ca>.
(defconst awk-font-lock-keywords
(eval-when-compile
(list
;;
;; Function names.
'("^[ \t]*\\(function\\)\\>[ \t]*\\(\\sw+\\)?"
(1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
;;
;; Variable names.
(cons (regexp-opt
'("ARGC" "ARGIND" "ARGV" "CONVFMT" "ENVIRON" "ERRNO"
"FIELDWIDTHS" "FILENAME" "FNR" "FS" "IGNORECASE" "NF" "NR"
"OFMT" "OFS" "ORS" "RLENGTH" "RS" "RSTART" "SUBSEP") 'words)
'font-lock-variable-name-face)
;;
;; Keywords.
(regexp-opt
'("BEGIN" "END" "break" "continue" "delete" "do" "exit" "else" "for"
"getline" "if" "next" "print" "printf" "return" "while") 'words)
;;
;; Builtins.
(list (regexp-opt
'("atan2" "close" "cos" "ctime" "exp" "gsub" "index" "int"
"length" "log" "match" "rand" "sin" "split" "sprintf"
"sqrt" "srand" "sub" "substr" "system" "time"
"tolower" "toupper") 'words)
1 'font-lock-builtin-face)
;;
;; Operators. Is this too much?
(cons (regexp-opt '("&&" "||" "<=" "<" ">=" ">" "==" "!=" "!~" "~"))
'font-lock-constant-face)
))
"Default expressions to highlight in AWK mode.")
(require 'syntax)
(defconst awk-font-lock-syntactic-keywords
;; `/' is mostly used for /.../ regular expressions, but is also
;; used as a division operator. Distinguishing between the two is
;; a pain in the youknowwhat.
;; '(("\\(^\\|[<=>-+*%/!^,~(?:|&]\\)\\s-*\\(/\\)\\([^/\n\\]\\|\\\\.\\)*\\(/\\)"
;; (2 "\"") (4 "\"")))
'(("[^<=>-+*%/!^,~(?:|& \t\n\f]\\s-*\\(/\\)"
(1 (unless (nth 3 (syntax-ppss (match-beginning 1))) "."))))
"Syntactic keywords for `awk-mode'.")
;; No longer autoloaded since it might clobber the autoload directive in CC Mode.
(define-derived-mode awk-mode c-mode "AWK"
"Major mode for editing AWK code.
This is much like C mode except for the syntax of comments. Its keymap
inherits from C mode's and it has the same variables for customizing
indentation. It has its own abbrev table and its own syntax table.
Turning on AWK mode runs `awk-mode-hook'."
(set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter))
(set (make-local-variable 'paragraph-separate) paragraph-start)
(set (make-local-variable 'comment-start) "# ")
(set (make-local-variable 'comment-end) "")
(set (make-local-variable 'comment-start-skip) "#+ *")
(setq font-lock-defaults '(awk-font-lock-keywords
nil nil ((?_ . "w")) nil
(parse-sexp-lookup-properties . t)
(font-lock-syntactic-keywords
. awk-font-lock-syntactic-keywords))))
(provide 'awk-mode)
;;; awk-mode.el ends here

489
lisp/obsolete/iso-acc.el
View file

@ -1,489 +0,0 @@
;;; iso-acc.el --- minor mode providing electric accent keys
;; Copyright (C) 1993-1994, 1996, 2001-2017 Free Software Foundation,
;; Inc.
;; Author: Johan Vromans
;; Maintainer: emacs-devel@gnu.org
;; Keywords: i18n
;; Obsolete-since: 22.1
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Function `iso-accents-mode' activates a minor mode in which
;; typewriter "dead keys" are emulated. The purpose of this emulation
;; is to provide a simple means for inserting accented characters
;; according to the ISO-8859-1...3 character sets.
;;
;; In `iso-accents-mode', pseudo accent characters are used to
;; introduce accented keys. The pseudo-accent characters are:
;;
;; ' (minute) -> acute accent
;; ` (backtick) -> grave accent
;; " (second) -> diaeresis
;; ^ (caret) -> circumflex
;; ~ (tilde) -> tilde over the character
;; / (slash) -> slash through the character.
;; Also: /A is A-with-ring and /E is AE ligature.
;; These two are enabled only if you set iso-accents-enable
;; to include them:
;; . (period) -> dot over the character (some languages only)
;; , (cedilla) -> cedilla under the character (some languages only)
;;
;; The action taken depends on the key that follows the pseudo accent.
;; In general:
;;
;; pseudo-accent + appropriate letter -> accented letter
;; pseudo-accent + space -> pseudo-accent (except comma and period)
;; pseudo-accent + pseudo-accent -> accent (if available)
;; pseudo-accent + other -> pseudo-accent + other
;;
;; If the pseudo-accent is followed by anything else than a
;; self-insert-command, the dead-key code is terminated, the
;; pseudo-accent inserted ‘as is’ and the bell is rung to signal this.
;;
;; Function `iso-accents-mode' can be used to enable the iso accents
;; minor mode, or disable it.
;; If you want only some of these characters to serve as accents,
;; add a language to `iso-languages' which specifies the accent characters
;; that you want, then select the language with `iso-accents-customize'.
;;; Code:
(provide 'iso-acc)
(defgroup iso-acc nil
"Minor mode providing electric accent keys."
:prefix "iso-accents-"
:group 'i18n)
(defcustom iso-accents-insert-offset nonascii-insert-offset
"Offset added by ISO Accents mode to character codes 0200 and above."
:type 'integer
:group 'iso-acc)
(defvar iso-languages
'(("catalan"
;; Note this includes some extra characters used in Spanish,
;; on the idea that someone who uses Catalan is likely to use Spanish
;; as well.
(?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
(?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372)
(?\ . ?'))
(?` (?A . ?\300) (?E . ?\310) (?O . ?\322)
(?a . ?\340) (?e . ?\350) (?o . ?\362)
(?\ . ?`))
(?\" (?I . ?\317) (?U . ?\334) (?i . ?\357) (?u . ?\374)
(?\ . ?\"))
(?~ (?C . ?\307) (?N . ?\321) (?c . ?\347) (?n . ?\361)
(?> . ?\273) (?< . ?\253) (?! . ?\241) (?? . ?\277)
(?\ . ?\~)))
("esperanto"
(?^ (?H . ?\246) (?J . ?\254) (?h . ?\266) (?j . ?\274) (?C . ?\306)
(?G . ?\330) (?S . ?\336) (?c . ?\346) (?g . ?\370) (?s . ?\376)
(?^ . ?^) (?\ . ?^))
(?~ (?U . ?\335) (?u . ?\375) (?\ . ?~)))
("french"
(?' (?E . ?\311) (?C . ?\307) (?e . ?\351) (?c . ?\347)
(?\ . ?'))
(?` (?A . ?\300) (?E . ?\310) (?U . ?\331)
(?a . ?\340) (?e . ?\350) (?u . ?\371)
(?\ . ?`))
(?^ (?A . ?\302) (?E . ?\312) (?I . ?\316) (?O . ?\324) (?U . ?\333)
(?a . ?\342) (?e . ?\352) (?i . ?\356) (?o . ?\364) (?u . ?\373)
(?\ . ?^))
(?\" (?E . ?\313) (?I . ?\317)
(?e . ?\353) (?i . ?\357)
(?\ . ?\"))
(?~ (?< . ?\253) (?> . ?\273) (?C . ?\307) (?c . ?\347)
(?\ . ?~))
(?, (?C . ?\307) (?c . ?\347) (?\ . ?\,)))
("german"
(?\" (?A . ?\304) (?O . ?\326) (?U . ?\334)
(?a . ?\344) (?o . ?\366) (?u . ?\374) (?s . ?\337) (?\ . ?\")))
("irish"
(?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
(?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372)
(?\ . ?')))
("portuguese"
(?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
(?C . ?\307) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363)
(?u . ?\372) (?c . ?\347)
(?\ . ?'))
(?` (?A . ?\300) (?a . ?\340)
(?\ . ?`))
(?^ (?A . ?\302) (?E . ?\312) (?O . ?\324)
(?a . ?\342) (?e . ?\352) (?o . ?\364)
(?\ . ?^))
(?\" (?U . ?\334) (?u . ?\374)
(?\ . ?\"))
(?~ (?A . ?\303) (?O . ?\325) (?a . ?\343) (?o . ?\365)
(?C . ?\307) (?N . ?\321) (?c . ?\347) (?n . ?\361)
(?\ . ?~))
(?, (?c . ?\347) (?C . ?\307) (?, . ?,)))
("spanish"
(?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
(?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372)
(?\ . ?'))
(?\" (?U . ?\334) (?u . ?\374) (?\ . ?\"))
(?\~ (?N . ?\321) (?n . ?\361) (?> . ?\273) (?< . ?\253) (?! . ?\241)
(?? . ?\277) (?\ . ?\~)))
("latin-1"
(?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
(?Y . ?\335) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363)
(?u . ?\372) (?y . ?\375) (?' . ?\264)
(?\ . ?'))
(?` (?A . ?\300) (?E . ?\310) (?I . ?\314) (?O . ?\322) (?U . ?\331)
(?a . ?\340) (?e . ?\350) (?i . ?\354) (?o . ?\362) (?u . ?\371)
(?` . ?`) (?\ . ?`))
(?^ (?A . ?\302) (?E . ?\312) (?I . ?\316) (?O . ?\324) (?U . ?\333)
(?a . ?\342) (?e . ?\352) (?i . ?\356) (?o . ?\364) (?u . ?\373)
(?^ . ?^) (?\ . ?^))
(?\" (?A . ?\304) (?E . ?\313) (?I . ?\317) (?O . ?\326) (?U . ?\334)
(?a . ?\344) (?e . ?\353) (?i . ?\357) (?o . ?\366) (?s . ?\337)
(?u . ?\374) (?y . ?\377)
(?\" . ?\250) (?\ . ?\"))
(?~ (?A . ?\303) (?C . ?\307) (?D . ?\320) (?N . ?\321) (?O . ?\325)
(?T . ?\336) (?a . ?\343) (?c . ?\347) (?d . ?\360) (?n . ?\361)
(?o . ?\365) (?t . ?\376)
(?> . ?\273) (?< . ?\253) (?! . ?\241) (?? . ?\277)
(?\~ . ?\270) (?\ . ?~))
(?/ (?A . ?\305) (?E . ?\306) (?O . ?\330) (?a . ?\345) (?e . ?\346)
(?o . ?\370)
(?/ . ?\260) (?\ . ?/)))
("latin-2" latin-iso8859-2
(?' (?A . ?\301) (?C . ?\306) (?D . ?\320) (?E . ?\311) (?I . ?\315)
(?L . ?\305) (?N . ?\321) (?O . ?\323) (?R . ?\300) (?S . ?\246)
(?U . ?\332) (?Y . ?\335) (?Z . ?\254)
(?a . ?\341) (?c . ?\346) (?d . ?\360) (?e . ?\351) (?i . ?\355)
(?l . ?\345) (?n . ?\361) (?o . ?\363) (?r . ?\340) (?s . ?\266)
(?u . ?\372) (?y . ?\375) (?z . ?\274)
(?' . ?\264) (?\ . ?'))
(?` (?A . ?\241) (?C . ?\307) (?E . ?\312) (?L . ?\243) (?S . ?\252)
(?T . ?\336) (?Z . ?\257)
(?a . ?\261) (?l . ?\263) (?c . ?\347) (?e . ?\352) (?s . ?\272)
(?t . ?\376) (?z . ?\277)
(?` . ?\252)
(?. . ?\377) (?\ . ?`))
(?^ (?A . ?\302) (?I . ?\316) (?O . ?\324)
(?a . ?\342) (?i . ?\356) (?o . ?\364)
(?^ . ?^) ; no special code?
(?\ . ?^))
(?\" (?A . ?\304) (?E . ?\313) (?O . ?\326) (?U . ?\334)
(?a . ?\344) (?e . ?\353) (?o . ?\366) (?s . ?\337) (?u . ?\374)
(?\" . ?\250)
(?\ . ?\"))
(?~ (?A . ?\303) (?C . ?\310) (?D . ?\317) (?L . ?\245) (?N . ?\322)
(?O . ?\325) (?R . ?\330) (?S . ?\251) (?T . ?\253) (?U . ?\333)
(?Z . ?\256)
(?a . ?\343) (?c . ?\350) (?d . ?\357) (?l . ?\265) (?n . ?\362)
(?o . ?\365) (?r . ?\370) (?s . ?\271) (?t . ?\273) (?u . ?\373)
(?z . ?\276)
(?v . ?\242) ; v accent
(?\~ . ?\242) ; v accent
(?\. . ?\270) ; cedilla accent
(?\ . ?~)))
("latin-3" latin-iso8859-3
(?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
(?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372)
(?' . ?\264) (?\ . ?'))
(?` (?A . ?\300) (?E . ?\310) (?I . ?\314) (?O . ?\322) (?U . ?\331)
(?a . ?\340) (?e . ?\350) (?i . ?\354) (?o . ?\362) (?u . ?\371)
(?` . ?`) (?\ . ?`))
(?^ (?A . ?\302) (?C . ?\306) (?E . ?\312) (?G . ?\330) (?H . ?\246)
(?I . ?\316) (?J . ?\254) (?O . ?\324) (?S . ?\336) (?U . ?\333)
(?a . ?\342) (?c . ?\346) (?e . ?\352) (?g . ?\370) (?h . ?\266)
(?i . ?\356) (?j . ?\274) (?o . ?\364) (?s . ?\376) (?u . ?\373)
(?^ . ?^) (?\ . ?^))
(?\" (?A . ?\304) (?E . ?\313) (?I . ?\317) (?O . ?\326) (?U . ?\334)
(?a . ?\344) (?e . ?\353) (?i . ?\357) (?o . ?\366) (?u . ?\374)
(?s . ?\337)
(?\" . ?\250) (?\ . ?\"))
(?~ (?A . ?\303) (?C . ?\307) (?D . ?\320) (?N . ?\321) (?O . ?\325)
(?a . ?\343) (?c . ?\347) (?d . ?\360) (?n . ?\361) (?o . ?\365)
(?$ . ?\245) (?S . ?\252) (?s . ?\272) (?G . ?\253) (?g . ?\273)
(?U . ?\335) (?u . ?\375) (?` . ?\242)
(?~ . ?\270) (?\ . ?~))
(?/ (?C . ?\305) (?G . ?\325) (?H . ?\241) (?I . ?\251) (?Z . ?\257)
(?c . ?\345) (?g . ?\365) (?h . ?\261) (?i . ?\271) (?z . ?\277)
(?r . ?\256)
(?. . ?\377) (?# . ?\243) (?$ . ?\244)
(?/ . ?\260) (?\ . ?/))
(?. (?C . ?\305) (?G . ?\325) (?I . ?\251) (?Z . ?\257)
(?c . ?\345) (?g . ?\365) (?z . ?\277))))
"List of language-specific customizations for the ISO Accents mode.
Each element of the list is of the form
(LANGUAGE [CHARSET]
(PSEUDO-ACCENT MAPPINGS)
(PSEUDO-ACCENT MAPPINGS)
...)
LANGUAGE is a string naming the language.
CHARSET (which may be omitted) is the symbol name
of the character set used in this language.
If CHARSET is omitted, latin-iso8859-1 is the default.
PSEUDO-ACCENT is a char specifying an accent key.
MAPPINGS are cons cells of the form (CHAR . ISO-CHAR).
The net effect is that the key sequence PSEUDO-ACCENT CHAR is mapped
to ISO-CHAR on input.")
(defvar iso-language nil
"Language for which ISO Accents mode is currently customized.
Change it with the `iso-accents-customize' function.")
(defvar iso-accents-list nil
"Association list for ISO accent combinations, for the chosen language.")
(defcustom iso-accents-mode nil
"Non-nil enables ISO Accents mode.
Setting this variable makes it local to the current buffer.
See the function `iso-accents-mode'."
:type 'boolean
:group 'iso-acc)
(make-variable-buffer-local 'iso-accents-mode)
(defcustom iso-accents-enable '(?' ?` ?^ ?\" ?~ ?/)
"List of accent keys that become prefixes in ISO Accents mode.
The default is (?\\=' ?\\=` ?^ ?\" ?~ ?/), which contains all the supported
accent keys. If you set this variable to a list in which some of those
characters are missing, the missing ones do not act as accents.
Note that if you specify a language with `iso-accents-customize',
that can also turn off certain prefixes (whichever ones are not needed in
the language you choose)."
:type '(repeat character)
:group 'iso-acc)
(defun iso-accents-accent-key (prompt)
"Modify the following character by adding an accent to it."
;; Pick up the accent character.
(if (and iso-accents-mode
(memq last-input-event iso-accents-enable))
(iso-accents-compose prompt)
(vector last-input-event)))
;; The iso-accents-compose function is called deep inside Emacs' read
;; key sequence machinery, so the call to read-event below actually
;; recurses into that machinery. Doing that does not cause any
;; problem on its own, but read-event will have marked the window's
;; display matrix to be accurate -- which is broken by the subsequent
;; call to delete-region. Therefore, we must call force-window-update
;; after delete-region to explicitly clear the accurate state of the
;; window's display matrix.
(defun iso-accents-compose (prompt)
(let* ((first-char last-input-event)
(list (assq first-char iso-accents-list))
;; Wait for the second key and look up the combination.
(second-char (if (or prompt
(not (eq (key-binding "a")
'self-insert-command))
;; Not at start of a key sequence.
(> (length (this-single-command-keys)) 1)
;; Called from anything but the command loop.
this-command)
(progn
(message "%s%c"
(or prompt "Compose with ")
first-char)
(read-event))
(insert first-char)
(prog1 (read-event)
(delete-region (1- (point)) (point))
;; Display is no longer up-to-date.
(force-window-update (selected-window)))))
(entry (cdr (assq second-char list))))
(if entry
;; Found it: return the mapped char
(vector
(if (and enable-multibyte-characters
(>= entry ?\200))
(+ iso-accents-insert-offset entry)
entry))
;; Otherwise, advance and schedule the second key for execution.
(push second-char unread-command-events)
(vector first-char))))
;; It is a matter of taste if you want the minor mode indicated
;; in the mode line...
;; If so, uncomment the next four lines.
;; (or (assq 'iso-accents-mode minor-mode-alist)
;; (setq minor-mode-alist
;; (append minor-mode-alist
;; '((iso-accents-mode " ISO-Acc")))))
;;;###autoload
(defun iso-accents-mode (&optional arg)
"Toggle ISO Accents mode, in which accents modify the following letter.
This permits easy insertion of accented characters according to ISO-8859-1.
When Iso-accents mode is enabled, accent character keys
\(\\=`, \\=', \", ^, / and ~) do not self-insert; instead, they modify the following
letter key so that it inserts an ISO accented letter.
You can customize ISO Accents mode to a particular language
with the command `iso-accents-customize'.
Special combinations: ~c gives a c with cedilla,
~d gives an Icelandic eth (d with dash).
~t gives an Icelandic thorn.
\"s gives German sharp s.
/a gives a with ring.
/e gives an a-e ligature.
~< and ~> give guillemots.
~! gives an inverted exclamation mark.
~? gives an inverted question mark.
With an argument, a positive argument enables ISO Accents mode,
and a negative argument disables it."
(interactive "P")
(if (if arg
;; Negative arg means switch it off.
(<= (prefix-numeric-value arg) 0)
;; No arg means toggle.
iso-accents-mode)
(setq iso-accents-mode nil)
;; Enable electric accents.
(setq iso-accents-mode t)))
(defun iso-accents-customize (language)
"Customize the ISO accents machinery for a particular language.
It selects the customization based on the specifications in the
`iso-languages' variable."
(interactive (list (completing-read "Language: " iso-languages nil t)))
(let ((table (cdr (assoc language iso-languages)))
all-accents tail)
(if (not table)
(error "Unknown language `%s'" language)
(setq iso-accents-insert-offset (- (make-char (if (symbolp (car table))
(car table)
'latin-iso8859-1))
128))
(if (symbolp (car table))
(setq table (cdr table)))
(setq iso-language language
iso-accents-list table)
(if key-translation-map
(substitute-key-definition
'iso-accents-accent-key nil key-translation-map)
(setq key-translation-map (make-sparse-keymap)))
;; Set up translations for all the characters that are used as
;; accent prefixes in this language.
(setq tail iso-accents-list)
(while tail
(define-key key-translation-map (vector (car (car tail)))
'iso-accents-accent-key)
(setq tail (cdr tail))))))
(defun iso-accentuate (start end)
"Convert two-character sequences in region into accented characters.
Noninteractively, this operates on text from START to END.
This uses the same conversion that ISO Accents mode uses for type-in."
(interactive "r")
(save-excursion
(save-restriction
(narrow-to-region start end)
(goto-char start)
(forward-char 1)
(let (entry)
(while (< (point) end)
(if (and (memq (preceding-char) iso-accents-enable)
(setq entry (cdr (assq (following-char) (assq (preceding-char) iso-accents-list)))))
(progn
(forward-char -1)
(delete-char 2)
(insert entry)
(setq end (1- end)))
(forward-char 1)))))))
(defun iso-accent-rassoc-unit (value alist)
(let (elt acc)
(while (and alist (not elt))
(setq acc (car (car alist))
elt (car (rassq value (cdr (car alist))))
alist (cdr alist)))
(if elt
(cons acc elt))))
(defun iso-unaccentuate (start end)
"Convert accented characters in the region into two-character sequences.
Noninteractively, this operates on text from START to END.
This uses the opposite of the conversion done by ISO Accents mode for type-in."
(interactive "r")
(save-excursion
(save-restriction
(narrow-to-region start end)
(goto-char start)
(let (entry)
(while (< (point) end)
(if (and (> (following-char) 127)
(setq entry (iso-accent-rassoc-unit (following-char)
iso-accents-list)))
(progn
(delete-char 1)
(insert (car entry) (cdr entry))
(setq end (1+ end)))
(forward-char 1)))))))
(defun iso-deaccentuate (start end)
"Convert accented characters in the region into unaccented characters.
Noninteractively, this operates on text from START to END."
(interactive "r")
(save-excursion
(save-restriction
(narrow-to-region start end)
(goto-char start)
(let (entry)
(while (< (point) end)
(if (and (> (following-char) 127)
(setq entry (iso-accent-rassoc-unit (following-char)
iso-accents-list)))
(progn
(delete-char 1)
(insert (cdr entry)))
(forward-char 1)))))))
;; Set up the default settings.
(iso-accents-customize "latin-1")
;; Use Iso-Accents mode in the minibuffer
;; if it was in use in the previous buffer.
(defun iso-acc-minibuf-setup ()
(setq iso-accents-mode
(with-current-buffer (window-buffer minibuffer-scroll-window)
iso-accents-mode)))
(add-hook 'minibuffer-setup-hook 'iso-acc-minibuf-setup)
;;; iso-acc.el ends here

630
lisp/obsolete/iso-insert.el
View file

@ -1,630 +0,0 @@
;;; iso-insert.el --- insert functions for ISO 8859/1
;; Copyright (C) 1987, 1994, 2001-2017 Free Software Foundation, Inc.
;; Author: Howard Gayle
;; Maintainer: emacs-devel@gnu.org
;; Keywords: i18n
;; Obsolete-since: 22.1
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Provides keys for inserting ISO Latin-1 characters. They use the
;; prefix key C-x 8. Type C-x 8 C-h for a list.
;;; Code:
(defun insert-no-break-space ()
(interactive "*")
(insert ?\ )
)
(defun insert-inverted-exclamation-mark ()
(interactive "*")
(insert ?\¡)
)
(defun insert-cent-sign ()
(interactive "*")
(insert ?\¢)
)
(defun insert-pound-sign ()
(interactive "*")
(insert ?\£)
)
(defun insert-general-currency-sign ()
(interactive "*")
(insert ?\¤)
)
(defun insert-yen-sign ()
(interactive "*")
(insert ?\¥)
)
(defun insert-broken-vertical-line ()
(interactive "*")
(insert ?\¦)
)
(defun insert-section-sign ()
(interactive "*")
(insert ?\§)
)
(defun insert-diaeresis ()
(interactive "*")
(insert ?\¨)
)
(defun insert-copyright-sign ()
(interactive "*")
(insert ?\©)
)
(defun insert-ordinal-indicator-feminine ()
(interactive "*")
(insert ?\ª)
)
(defun insert-angle-quotation-mark-left ()
(interactive "*")
(insert ?\«)
)
(defun insert-not-sign ()
(interactive "*")
(insert ?\¬)
)
(defun insert-soft-hyphen ()
(interactive "*")
(insert ?\­)
)
(defun insert-registered-sign ()
(interactive "*")
(insert ?\®)
)
(defun insert-macron ()
(interactive "*")
(insert ?\¯)
)
(defun insert-degree-sign ()
(interactive "*")
(insert ?\°)
)
(defun insert-plus-or-minus-sign ()
(interactive "*")
(insert ?\±)
)
(defun insert-superscript-two ()
(interactive "*")
(insert ?\²)
)
(defun insert-superscript-three ()
(interactive "*")
(insert ?\³)
)
(defun insert-acute-accent ()
(interactive "*")
(insert ?\´)
)
(defun insert-micro-sign ()
(interactive "*")
(insert ?\µ)
)
(defun insert-pilcrow ()
(interactive "*")
(insert ?\¶)
)
(defun insert-middle-dot ()
(interactive "*")
(insert ?\·)
)
(defun insert-cedilla ()
(interactive "*")
(insert ?\¸)
)
(defun insert-superscript-one ()
(interactive "*")
(insert ?\¹)
)
(defun insert-ordinal-indicator-masculine ()
(interactive "*")
(insert ?\º)
)
(defun insert-angle-quotation-mark-right ()
(interactive "*")
(insert ?\»)
)
(defun insert-fraction-one-quarter ()
(interactive "*")
(insert ?\¼)
)
(defun insert-fraction-one-half ()
(interactive "*")
(insert ?\½)
)
(defun insert-fraction-three-quarters ()
(interactive "*")
(insert ?\¾)
)
(defun insert-inverted-question-mark ()
(interactive "*")
(insert ?\¿)
)
(defun insert-A-grave ()
(interactive "*")
(insert ?\À)
)
(defun insert-A-acute ()
(interactive "*")
(insert ?\Á)
)
(defun insert-A-circumflex ()
(interactive "*")
(insert ?\Â)
)
(defun insert-A-tilde ()
(interactive "*")
(insert ?\Ã)
)
(defun insert-A-umlaut ()
(interactive "*")
(insert ?\Ä)
)
(defun insert-A-ring ()
(interactive "*")
(insert ?\Å)
)
(defun insert-AE ()
(interactive "*")
(insert ?\Æ)
)
(defun insert-C-cedilla ()
(interactive "*")
(insert ?\Ç)
)
(defun insert-E-grave ()
(interactive "*")
(insert ?\È)
)
(defun insert-E-acute ()
(interactive "*")
(insert ?\É)
)
(defun insert-E-circumflex ()
(interactive "*")
(insert ?\Ê)
)
(defun insert-E-umlaut ()
(interactive "*")
(insert ?\Ë)
)
(defun insert-I-grave ()
(interactive "*")
(insert ?\Ì)
)
(defun insert-I-acute ()
(interactive "*")
(insert ?\Í)
)
(defun insert-I-circumflex ()
(interactive "*")
(insert ?\Î)
)
(defun insert-I-umlaut ()
(interactive "*")
(insert ?\Ï)
)
(defun insert-D-stroke ()
(interactive "*")
(insert ?\Ð)
)
(defun insert-N-tilde ()
(interactive "*")
(insert ?\Ñ)
)
(defun insert-O-grave ()
(interactive "*")
(insert ?\Ò)
)
(defun insert-O-acute ()
(interactive "*")
(insert ?\Ó)
)
(defun insert-O-circumflex ()
(interactive "*")
(insert ?\Ô)
)
(defun insert-O-tilde ()
(interactive "*")
(insert ?\Õ)
)
(defun insert-O-umlaut ()
(interactive "*")
(insert ?\Ö)
)
(defun insert-multiplication-sign ()
(interactive "*")
(insert ?\×)
)
(defun insert-O-slash ()
(interactive "*")
(insert ?\Ø)
)
(defun insert-U-grave ()
(interactive "*")
(insert ?\Ù)
)
(defun insert-U-acute ()
(interactive "*")
(insert ?\Ú)
)
(defun insert-U-circumflex ()
(interactive "*")
(insert ?\Û)
)
(defun insert-U-umlaut ()
(interactive "*")
(insert ?\Ü)
)
(defun insert-Y-acute ()
(interactive "*")
(insert ?\Ý)
)
(defun insert-THORN ()
(interactive "*")
(insert ?\Þ)
)
(defun insert-ss ()
(interactive "*")
(insert ?\ß)
)
(defun insert-a-grave ()
(interactive "*")
(insert ?\à)
)
(defun insert-a-acute ()
(interactive "*")
(insert ?\á)
)
(defun insert-a-circumflex ()
(interactive "*")
(insert ?\â)
)
(defun insert-a-tilde ()
(interactive "*")
(insert ?\ã)
)
(defun insert-a-umlaut ()
(interactive "*")
(insert ?\ä)
)
(defun insert-a-ring ()
(interactive "*")
(insert ?\å)
)
(defun insert-ae ()
(interactive "*")
(insert ?\æ)
)
(defun insert-c-cedilla ()
(interactive "*")
(insert ?\ç)
)
(defun insert-e-grave ()
(interactive "*")
(insert ?\è)
)
(defun insert-e-acute ()
(interactive "*")
(insert ?\é)
)
(defun insert-e-circumflex ()
(interactive "*")
(insert ?\ê)
)
(defun insert-e-umlaut ()
(interactive "*")
(insert ?\ë)
)
(defun insert-i-grave ()
(interactive "*")
(insert ?\ì)
)
(defun insert-i-acute ()
(interactive "*")
(insert ?\í)
)
(defun insert-i-circumflex ()
(interactive "*")
(insert ?\î)
)
(defun insert-i-umlaut ()
(interactive "*")
(insert ?\ï)
)
(defun insert-d-stroke ()
(interactive "*")
(insert ?\ð)
)
(defun insert-n-tilde ()
(interactive "*")
(insert ?\ñ)
)
(defun insert-o-grave ()
(interactive "*")
(insert ?\ò)
)
(defun insert-o-acute ()
(interactive "*")
(insert ?\ó)
)
(defun insert-o-circumflex ()
(interactive "*")
(insert ?\ô)
)
(defun insert-o-tilde ()
(interactive "*")
(insert ?\õ)
)
(defun insert-o-umlaut ()
(interactive "*")
(insert ?\ö)
)
(defun insert-division-sign ()
(interactive "*")
(insert ?\÷)
)
(defun insert-o-slash ()
(interactive "*")
(insert ?\ø)
)
(defun insert-u-grave ()
(interactive "*")
(insert ?\ù)
)
(defun insert-u-acute ()
(interactive "*")
(insert ?\ú)
)
(defun insert-u-circumflex ()
(interactive "*")
(insert ?\û)
)
(defun insert-u-umlaut ()
(interactive "*")
(insert ?\ü)
)
(defun insert-y-acute ()
(interactive "*")
(insert ?\ý)
)
(defun insert-thorn ()
(interactive "*")
(insert ?\þ)
)
(defun insert-y-umlaut ()
(interactive "*")
(insert ?\ÿ)
)
(defvar 8859-1-map nil "Keymap for ISO 8859/1 character insertion.")
(if 8859-1-map nil
(setq 8859-1-map (make-keymap))
(define-key 8859-1-map " " 'insert-no-break-space)
(define-key 8859-1-map "!" 'insert-inverted-exclamation-mark)
(define-key 8859-1-map "\"" (make-sparse-keymap))
(define-key 8859-1-map "\"\"" 'insert-diaeresis)
(define-key 8859-1-map "\"A" 'insert-A-umlaut)
(define-key 8859-1-map "\"E" 'insert-E-umlaut)
(define-key 8859-1-map "\"I" 'insert-I-umlaut)
(define-key 8859-1-map "\"O" 'insert-O-umlaut)
(define-key 8859-1-map "\"U" 'insert-U-umlaut)
(define-key 8859-1-map "\"a" 'insert-a-umlaut)
(define-key 8859-1-map "\"e" 'insert-e-umlaut)
(define-key 8859-1-map "\"i" 'insert-i-umlaut)
(define-key 8859-1-map "\"o" 'insert-o-umlaut)
(define-key 8859-1-map "\"u" 'insert-u-umlaut)
(define-key 8859-1-map "\"y" 'insert-y-umlaut)
(define-key 8859-1-map "'" (make-sparse-keymap))
(define-key 8859-1-map "''" 'insert-acute-accent)
(define-key 8859-1-map "'A" 'insert-A-acute)
(define-key 8859-1-map "'E" 'insert-E-acute)
(define-key 8859-1-map "'I" 'insert-I-acute)
(define-key 8859-1-map "'O" 'insert-O-acute)
(define-key 8859-1-map "'U" 'insert-U-acute)
(define-key 8859-1-map "'Y" 'insert-Y-acute)
(define-key 8859-1-map "'a" 'insert-a-acute)
(define-key 8859-1-map "'e" 'insert-e-acute)
(define-key 8859-1-map "'i" 'insert-i-acute)
(define-key 8859-1-map "'o" 'insert-o-acute)
(define-key 8859-1-map "'u" 'insert-u-acute)
(define-key 8859-1-map "'y" 'insert-y-acute)
(define-key 8859-1-map "$" 'insert-general-currency-sign)
(define-key 8859-1-map "+" 'insert-plus-or-minus-sign)
(define-key 8859-1-map "," (make-sparse-keymap))
(define-key 8859-1-map ",," 'insert-cedilla)
(define-key 8859-1-map ",C" 'insert-C-cedilla)
(define-key 8859-1-map ",c" 'insert-c-cedilla)
(define-key 8859-1-map "-" 'insert-soft-hyphen)
(define-key 8859-1-map "." 'insert-middle-dot)
(define-key 8859-1-map "/" (make-sparse-keymap))
(define-key 8859-1-map "//" 'insert-division-sign)
(define-key 8859-1-map "/O" 'insert-O-slash)
(define-key 8859-1-map "/o" 'insert-o-slash)
(define-key 8859-1-map "1" (make-sparse-keymap))
(define-key 8859-1-map "1/" (make-sparse-keymap))
(define-key 8859-1-map "1/2" 'insert-fraction-one-half)
(define-key 8859-1-map "1/4" 'insert-fraction-one-quarter)
(define-key 8859-1-map "3" (make-sparse-keymap))
(define-key 8859-1-map "3/" (make-sparse-keymap))
(define-key 8859-1-map "3/4" 'insert-fraction-three-quarters)
(define-key 8859-1-map "<" 'insert-angle-quotation-mark-left)
(define-key 8859-1-map "=" 'insert-macron)
(define-key 8859-1-map ">" 'insert-angle-quotation-mark-right)
(define-key 8859-1-map "?" 'insert-inverted-question-mark)
(define-key 8859-1-map "A" 'insert-A-ring)
(define-key 8859-1-map "E" 'insert-AE)
(define-key 8859-1-map "C" 'insert-copyright-sign)
(define-key 8859-1-map "D" 'insert-D-stroke)
(define-key 8859-1-map "L" 'insert-pound-sign)
(define-key 8859-1-map "P" 'insert-pilcrow)
(define-key 8859-1-map "R" 'insert-registered-sign)
(define-key 8859-1-map "S" 'insert-section-sign)
(define-key 8859-1-map "T" 'insert-THORN)
(define-key 8859-1-map "Y" 'insert-yen-sign)
(define-key 8859-1-map "^" (make-sparse-keymap))
(define-key 8859-1-map "^1" 'insert-superscript-one)
(define-key 8859-1-map "^2" 'insert-superscript-two)
(define-key 8859-1-map "^3" 'insert-superscript-three)
(define-key 8859-1-map "^A" 'insert-A-circumflex)
(define-key 8859-1-map "^E" 'insert-E-circumflex)
(define-key 8859-1-map "^I" 'insert-I-circumflex)
(define-key 8859-1-map "^O" 'insert-O-circumflex)
(define-key 8859-1-map "^U" 'insert-U-circumflex)
(define-key 8859-1-map "^a" 'insert-a-circumflex)
(define-key 8859-1-map "^e" 'insert-e-circumflex)
(define-key 8859-1-map "^i" 'insert-i-circumflex)
(define-key 8859-1-map "^o" 'insert-o-circumflex)
(define-key 8859-1-map "^u" 'insert-u-circumflex)
(define-key 8859-1-map "_" (make-sparse-keymap))
(define-key 8859-1-map "_a" 'insert-ordinal-indicator-feminine)
(define-key 8859-1-map "_o" 'insert-ordinal-indicator-masculine)
(define-key 8859-1-map "`" (make-sparse-keymap))
(define-key 8859-1-map "`A" 'insert-A-grave)
(define-key 8859-1-map "`E" 'insert-E-grave)
(define-key 8859-1-map "`I" 'insert-I-grave)
(define-key 8859-1-map "`O" 'insert-O-grave)
(define-key 8859-1-map "`U" 'insert-U-grave)
(define-key 8859-1-map "`a" 'insert-a-grave)
(define-key 8859-1-map "`e" 'insert-e-grave)
(define-key 8859-1-map "`i" 'insert-i-grave)
(define-key 8859-1-map "`o" 'insert-o-grave)
(define-key 8859-1-map "`u" 'insert-u-grave)
(define-key 8859-1-map "a" 'insert-a-ring)
(define-key 8859-1-map "e" 'insert-ae)
(define-key 8859-1-map "c" 'insert-cent-sign)
(define-key 8859-1-map "d" 'insert-d-stroke)
(define-key 8859-1-map "o" 'insert-degree-sign)
(define-key 8859-1-map "s" 'insert-ss)
(define-key 8859-1-map "t" 'insert-thorn)
(define-key 8859-1-map "u" 'insert-micro-sign)
(define-key 8859-1-map "x" 'insert-multiplication-sign)
(define-key 8859-1-map "|" 'insert-broken-vertical-line)
(define-key 8859-1-map "~" (make-sparse-keymap))
(define-key 8859-1-map "~A" 'insert-A-tilde)
(define-key 8859-1-map "~N" 'insert-N-tilde)
(define-key 8859-1-map "~O" 'insert-O-tilde)
(define-key 8859-1-map "~a" 'insert-a-tilde)
(define-key 8859-1-map "~n" 'insert-n-tilde)
(define-key 8859-1-map "~o" 'insert-o-tilde)
(define-key 8859-1-map "~~" 'insert-not-sign)
(if (not (lookup-key global-map "\C-x8"))
(define-key global-map "\C-x8" 8859-1-map))
)
(defalias '8859-1-map 8859-1-map)
(provide 'iso-insert)
;;; iso-insert.el ends here

150
lisp/obsolete/iso-swed.el
View file

@ -1,150 +0,0 @@
;;; iso-swed.el --- set up char tables for ISO 8859/1 for Swedish/Finnish ttys
;; Copyright (C) 1987, 2001-2017 Free Software Foundation, Inc.
;; Author: Howard Gayle
;; Maintainer: emacs-devel@gnu.org
;; Keywords: i18n
;; Obsolete-since: 22.1
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Written by Howard Gayle. See case-table.el for details.
;;; Code:
;; This code sets up to display ISO 8859/1 characters on
;; terminals that have ASCII in the G0 set and a Swedish/Finnish
;; version of ISO 646 in the G1 set. The G1 set differs from
;; ASCII as follows:
;;
;; ASCII G1
;; $ general currency sign
;; @ capital E with acute accent
;; [ capital A with diaeresis or umlaut mark
;; \ capital O with diaeresis or umlaut mark
;; ] capital A with ring
;; ^ capital U with diaeresis or umlaut mark
;; ` small e with acute accent
;; { small a with diaeresis or umlaut mark
;; | small o with diaeresis or umlaut mark
;; } small a with ring
;; ~ small u with diaeresis or umlaut mark
(require 'disp-table)
(standard-display-ascii 160 "{_}") ; NBSP (no-break space)
(standard-display-ascii 161 "{!}") ; inverted exclamation mark
(standard-display-ascii 162 "{c}") ; cent sign
(standard-display-ascii 163 "{GBP}") ; pound sign
(standard-display-g1 164 ?$) ; general currency sign
(standard-display-ascii 165 "{JPY}") ; yen sign
(standard-display-ascii 166 "{|}") ; broken vertical line
(standard-display-ascii 167 "{S}") ; section sign
(standard-display-ascii 168 "{\"}") ; diaeresis
(standard-display-ascii 169 "{C}") ; copyright sign
(standard-display-ascii 170 "{_a}") ; ordinal indicator, feminine
(standard-display-ascii 171 "{<<}") ; left angle quotation mark
(standard-display-ascii 172 "{~}") ; not sign
(standard-display-ascii 173 "{-}") ; soft hyphen
(standard-display-ascii 174 "{R}") ; registered sign
(standard-display-ascii 175 "{=}") ; macron
(standard-display-ascii 176 "{o}") ; degree sign
(standard-display-ascii 177 "{+-}") ; plus or minus sign
(standard-display-ascii 178 "{2}") ; superscript two
(standard-display-ascii 179 "{3}") ; superscript three
(standard-display-ascii 180 "{'}") ; acute accent
(standard-display-ascii 181 "{u}") ; micro sign
(standard-display-ascii 182 "{P}") ; pilcrow
(standard-display-ascii 183 "{.}") ; middle dot
(standard-display-ascii 184 "{,}") ; cedilla
(standard-display-ascii 185 "{1}") ; superscript one
(standard-display-ascii 186 "{_o}") ; ordinal indicator, masculine
(standard-display-ascii 187 "{>>}") ; right angle quotation mark
(standard-display-ascii 188 "{1/4}") ; fraction one-quarter
(standard-display-ascii 189 "{1/2}") ; fraction one-half
(standard-display-ascii 190 "{3/4}") ; fraction three-quarters
(standard-display-ascii 191 "{?}") ; inverted question mark
(standard-display-ascii 192 "{`A}") ; A with grave accent
(standard-display-ascii 193 "{'A}") ; A with acute accent
(standard-display-ascii 194 "{^A}") ; A with circumflex accent
(standard-display-ascii 195 "{~A}") ; A with tilde
(standard-display-g1 196 ?[) ; A with diaeresis or umlaut mark
(standard-display-g1 197 ?]) ; A with ring
(standard-display-ascii 198 "{AE}") ; AE diphthong
(standard-display-ascii 199 "{,C}") ; C with cedilla
(standard-display-ascii 200 "{`E}") ; E with grave accent
(standard-display-g1 201 ?@) ; E with acute accent
(standard-display-ascii 202 "{^E}") ; E with circumflex accent
(standard-display-ascii 203 "{\"E}") ; E with diaeresis or umlaut mark
(standard-display-ascii 204 "{`I}") ; I with grave accent
(standard-display-ascii 205 "{'I}") ; I with acute accent
(standard-display-ascii 206 "{^I}") ; I with circumflex accent
(standard-display-ascii 207 "{\"I}") ; I with diaeresis or umlaut mark
(standard-display-ascii 208 "{-D}") ; D with stroke, Icelandic eth
(standard-display-ascii 209 "{~N}") ; N with tilde
(standard-display-ascii 210 "{`O}") ; O with grave accent
(standard-display-ascii 211 "{'O}") ; O with acute accent
(standard-display-ascii 212 "{^O}") ; O with circumflex accent
(standard-display-ascii 213 "{~O}") ; O with tilde
(standard-display-g1 214 ?\\) ; O with diaeresis or umlaut mark
(standard-display-ascii 215 "{x}") ; multiplication sign
(standard-display-ascii 216 "{/O}") ; O with slash
(standard-display-ascii 217 "{`U}") ; U with grave accent
(standard-display-ascii 218 "{'U}") ; U with acute accent
(standard-display-ascii 219 "{^U}") ; U with circumflex accent
(standard-display-g1 220 ?^) ; U with diaeresis or umlaut mark
(standard-display-ascii 221 "{'Y}") ; Y with acute accent
(standard-display-ascii 222 "{TH}") ; capital thorn, Icelandic
(standard-display-ascii 223 "{ss}") ; small sharp s, German
(standard-display-ascii 224 "{`a}") ; a with grave accent
(standard-display-ascii 225 "{'a}") ; a with acute accent
(standard-display-ascii 226 "{^a}") ; a with circumflex accent
(standard-display-ascii 227 "{~a}") ; a with tilde
(standard-display-g1 228 ?{) ; a with diaeresis or umlaut mark
(standard-display-g1 229 ?}) ; a with ring
(standard-display-ascii 230 "{ae}") ; ae diphthong
(standard-display-ascii 231 "{,c}") ; c with cedilla
(standard-display-ascii 232 "{`e}") ; e with grave accent
(standard-display-g1 233 ?`) ; e with acute accent
(standard-display-ascii 234 "{^e}") ; e with circumflex accent
(standard-display-ascii 235 "{\"e}") ; e with diaeresis or umlaut mark
(standard-display-ascii 236 "{`i}") ; i with grave accent
(standard-display-ascii 237 "{'i}") ; i with acute accent
(standard-display-ascii 238 "{^i}") ; i with circumflex accent
(standard-display-ascii 239 "{\"i}") ; i with diaeresis or umlaut mark
(standard-display-ascii 240 "{-d}") ; d with stroke, Icelandic eth
(standard-display-ascii 241 "{~n}") ; n with tilde
(standard-display-ascii 242 "{`o}") ; o with grave accent
(standard-display-ascii 243 "{'o}") ; o with acute accent
(standard-display-ascii 244 "{^o}") ; o with circumflex accent
(standard-display-ascii 245 "{~o}") ; o with tilde
(standard-display-g1 246 ?|) ; o with diaeresis or umlaut mark
(standard-display-ascii 247 "{/}") ; division sign
(standard-display-ascii 248 "{/o}") ; o with slash
(standard-display-ascii 249 "{`u}") ; u with grave accent
(standard-display-ascii 250 "{'u}") ; u with acute accent
(standard-display-ascii 251 "{^u}") ; u with circumflex accent
(standard-display-g1 252 ?~) ; u with diaeresis or umlaut mark
(standard-display-ascii 253 "{'y}") ; y with acute accent
(standard-display-ascii 254 "{th}") ; small thorn, Icelandic
(standard-display-ascii 255 "{\"y}") ; small y with diaeresis or umlaut mark
(provide 'iso-swed)
;;; iso-swed.el ends here

125
lisp/obsolete/resume.el
View file

@ -1,125 +0,0 @@
;;; resume.el --- process command line args from within a suspended Emacs job
;; Copyright (C) 1992, 2001-2017 Free Software Foundation, Inc.
;; Author: Joe Wells <jbw@bucsf.bu.edu>
;; Adapted-By: ESR
;; Keywords: processes
;; Obsolete-since: 23.1
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; The purpose of this library is to handle command line arguments
;; when you resume an existing Emacs job.
;; In order to use it, you must put this code in your .emacs file.
;; (add-hook 'suspend-hook 'resume-suspend-hook)
;; (add-hook 'suspend-resume-hook 'resume-process-args)
;; You can't get the benefit of this library by using the `emacs' command,
;; since that always starts a new Emacs job. Instead you must use a
;; command called `edit' which knows how to resume an existing Emacs job
;; if you have one, or start a new Emacs job if you don't have one.
;; To define the `edit' command, run the script etc/emacs.csh (if you use CSH),
;; or etc/emacs.bash if you use BASH. You would normally do this in your
;; login script.
;; Stephan Gildea suggested bug fix (gildea@bbn.com).
;; Ideas from Michael DeCorte and other people.
;;; Code:
(defvar resume-emacs-args-file (expand-file-name "~/.emacs_args")
"This file is where arguments are placed for a suspended Emacs job.")
(defvar resume-emacs-args-buffer " *Command Line Args*"
"Buffer that is used by `resume-process-args'.")
(defun resume-process-args ()
"Handler for command line args given when Emacs is resumed."
(let ((start-buffer (current-buffer))
(args-buffer (get-buffer-create resume-emacs-args-buffer))
length args
(command-line-default-directory default-directory))
(unwind-protect
(progn
(set-buffer args-buffer)
(erase-buffer)
;; get the contents of resume-emacs-args-file
(condition-case ()
(let ((result (insert-file-contents resume-emacs-args-file)))
(setq length (car (cdr result))))
;; the file doesn't exist, ergo no arguments
(file-error
(erase-buffer)
(setq length 0)))
(if (<= length 0)
(setq args nil)
;; get the arguments from the buffer
(goto-char (point-min))
(while (not (eobp))
(skip-chars-forward " \t\n")
(let ((begin (point)))
(skip-chars-forward "^ \t\n")
(setq args (cons (buffer-substring begin (point)) args)))
(skip-chars-forward " \t\n"))
;; arguments are now in reverse order
(setq args (nreverse args))
;; make sure they're not read again
(erase-buffer))
(resume-write-buffer-to-file (current-buffer) resume-emacs-args-file)
;; if nothing was in buffer, args will be null
(or (null args)
(setq command-line-default-directory
(file-name-as-directory (car args))
args (cdr args)))
;; actually process the arguments
(command-line-1 args))
;; If the command line args don't result in a find-file, the
;; buffer will be left in args-buffer. So we change back to the
;; original buffer. The reason I don't just use
;; (let ((default-directory foo))
;; (command-line-1 args))
;; in the context of the original buffer is because let does not
;; work properly with buffer-local variables.
(if (eq (current-buffer) args-buffer)
(set-buffer start-buffer)))))
;;;###autoload
(defun resume-suspend-hook ()
"Clear out the file used for transmitting args when Emacs resumes."
(with-current-buffer (get-buffer-create resume-emacs-args-buffer)
(erase-buffer)
(resume-write-buffer-to-file (current-buffer) resume-emacs-args-file)))
(defun resume-write-buffer-to-file (buffer file)
"Writes the contents of BUFFER into FILE, if permissions allow."
(if (not (file-writable-p file))
(error "No permission to write file %s" file))
(with-current-buffer buffer
(clear-visited-file-modtime)
(save-restriction
(widen)
(write-region (point-min) (point-max) file nil 'quiet))
(set-buffer-modified-p nil)))
(provide 'resume)
;;; resume.el ends here

329
lisp/obsolete/scribe.el
View file

@ -1,329 +0,0 @@
;;; scribe.el --- scribe mode, and its idiosyncratic commands
;; Copyright (C) 1985, 2001-2017 Free Software Foundation, Inc.
;; Author: William Sommerfeld
;; (according to ack.texi)
;; Maintainer: emacs-devel@gnu.org
;; Keywords: wp
;; Obsolete-since: 22.1
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; A major mode for editing source in written for the Scribe text formatter.
;; Knows about Scribe syntax and standard layout rules. The command to
;; run Scribe on a buffer is bogus; someone interested should fix it.
;;; Code:
(defvar compile-command)
(defgroup scribe nil
"Scribe mode."
:prefix "scribe-"
:group 'wp)
(defvar scribe-mode-syntax-table nil
"Syntax table used while in scribe mode.")
(defvar scribe-mode-abbrev-table nil
"Abbrev table used while in scribe mode.")
(defcustom scribe-fancy-paragraphs nil
"Non-nil makes Scribe mode use a different style of paragraph separation."
:type 'boolean
:group 'scribe)
(defcustom scribe-electric-quote nil
"Non-nil makes insert of double quote use \\=`\\=` or \\='\\=' depending on context."
:type 'boolean
:group 'scribe)
(defcustom scribe-electric-parenthesis nil
"Non-nil makes parenthesis char ( (]}> ) automatically insert its close
if typed after an @Command form."
:type 'boolean
:group 'scribe)
(defconst scribe-open-parentheses "[({<"
"Open parenthesis characters for Scribe.")
(defconst scribe-close-parentheses "])}>"
"Close parenthesis characters for Scribe.
These should match up with `scribe-open-parenthesis'.")
(if (null scribe-mode-syntax-table)
(let ((st (syntax-table)))
(unwind-protect
(progn
(setq scribe-mode-syntax-table (copy-syntax-table
text-mode-syntax-table))
(set-syntax-table scribe-mode-syntax-table)
(modify-syntax-entry ?\" " ")
(modify-syntax-entry ?\\ " ")
(modify-syntax-entry ?@ "w ")
(modify-syntax-entry ?< "(> ")
(modify-syntax-entry ?> ")< ")
(modify-syntax-entry ?[ "(] ")
(modify-syntax-entry ?] ")[ ")
(modify-syntax-entry ?{ "(} ")
(modify-syntax-entry ?} "){ ")
(modify-syntax-entry ?' "w "))
(set-syntax-table st))))
(defvar scribe-mode-map nil)
(if scribe-mode-map
nil
(setq scribe-mode-map (make-sparse-keymap))
(define-key scribe-mode-map "\t" 'scribe-tab)
(define-key scribe-mode-map "\e\t" 'tab-to-tab-stop)
(define-key scribe-mode-map "\es" 'center-line)
(define-key scribe-mode-map "\e}" 'up-list)
(define-key scribe-mode-map "\eS" 'center-paragraph)
(define-key scribe-mode-map "\"" 'scribe-insert-quote)
(define-key scribe-mode-map "(" 'scribe-parenthesis)
(define-key scribe-mode-map "[" 'scribe-parenthesis)
(define-key scribe-mode-map "{" 'scribe-parenthesis)
(define-key scribe-mode-map "<" 'scribe-parenthesis)
(define-key scribe-mode-map "\C-c\C-c" 'scribe-chapter)
(define-key scribe-mode-map "\C-c\C-t" 'scribe-section)
(define-key scribe-mode-map "\C-c\C-s" 'scribe-subsection)
(define-key scribe-mode-map "\C-c\C-v" 'scribe-insert-environment)
(define-key scribe-mode-map "\C-c\C-e" 'scribe-bracket-region-be)
(define-key scribe-mode-map "\C-c[" 'scribe-begin)
(define-key scribe-mode-map "\C-c]" 'scribe-end)
(define-key scribe-mode-map "\C-c\C-i" 'scribe-italicize-word)
(define-key scribe-mode-map "\C-c\C-b" 'scribe-bold-word)
(define-key scribe-mode-map "\C-c\C-u" 'scribe-underline-word))
;;;###autoload
(define-derived-mode scribe-mode text-mode "Scribe"
"Major mode for editing files of Scribe (a text formatter) source.
Scribe-mode is similar to text-mode, with a few extra commands added.
\\{scribe-mode-map}
Interesting variables:
`scribe-fancy-paragraphs'
Non-nil makes Scribe mode use a different style of paragraph separation.
`scribe-electric-quote'
Non-nil makes insert of double quote use \\=`\\=` or \\='\\=' depending on context.
`scribe-electric-parenthesis'
Non-nil makes an open-parenthesis char (one of `([<{')
automatically insert its close if typed after an @Command form."
(set (make-local-variable 'comment-start) "@Comment[")
(set (make-local-variable 'comment-start-skip) (concat "@Comment[" scribe-open-parentheses "]"))
(set (make-local-variable 'comment-column) 0)
(set (make-local-variable 'comment-end) "]")
(set (make-local-variable 'paragraph-start)
(concat "\\([\n\f]\\)\\|\\(@\\w+["
scribe-open-parentheses
"].*["
scribe-close-parentheses
"]$\\)"))
(set (make-local-variable 'paragraph-separate)
(if scribe-fancy-paragraphs paragraph-start "$"))
(set (make-local-variable 'sentence-end)
"\\([.?!]\\|@:\\)[]\"')}]*\\($\\| $\\|\t\\| \\)[ \t\n]*")
(set (make-local-variable 'compile-command)
(concat "scribe "
(if buffer-file-name
(shell-quote-argument (buffer-file-name))))))
(defun scribe-tab ()
(interactive)
(insert "@\\"))
;; This algorithm could probably be improved somewhat.
;; Right now, it loses seriously...
(defun scribe ()
"Run Scribe on the current buffer."
(interactive)
(call-interactively 'compile))
(defun scribe-envelop-word (string count)
"Surround current word with Scribe construct @STRING[...].
COUNT specifies how many words to surround. A negative count means
to skip backward."
(let ((spos (point)) (epos (point)) (ccoun 0) noparens)
(if (not (zerop count))
(progn (if (= (char-syntax (preceding-char)) ?w)
(forward-sexp (min -1 count)))
(setq spos (point))
(if (looking-at (concat "@\\w[" scribe-open-parentheses "]"))
(forward-char 2)
(goto-char epos)
(skip-chars-backward "\\W")
(forward-char -1))
(forward-sexp (max count 1))
(setq epos (point))))
(goto-char spos)
(while (and (< ccoun (length scribe-open-parentheses))
(save-excursion
(or (search-forward (char-to-string
(aref scribe-open-parentheses ccoun))
epos t)
(search-forward (char-to-string
(aref scribe-close-parentheses ccoun))
epos t)))
(setq ccoun (1+ ccoun))))
(if (>= ccoun (length scribe-open-parentheses))
(progn (goto-char epos)
(insert "@end(" string ")")
(goto-char spos)
(insert "@begin(" string ")"))
(goto-char epos)
(insert (aref scribe-close-parentheses ccoun))
(goto-char spos)
(insert "@" string (aref scribe-open-parentheses ccoun))
(goto-char epos)
(forward-char 3)
(skip-chars-forward scribe-close-parentheses))))
(defun scribe-underline-word (count)
"Underline COUNT words around point by means of Scribe constructs."
(interactive "p")
(scribe-envelop-word "u" count))
(defun scribe-bold-word (count)
"Boldface COUNT words around point by means of Scribe constructs."
(interactive "p")
(scribe-envelop-word "b" count))
(defun scribe-italicize-word (count)
"Italicize COUNT words around point by means of Scribe constructs."
(interactive "p")
(scribe-envelop-word "i" count))
(defun scribe-begin ()
(interactive)
(insert "\n")
(forward-char -1)
(scribe-envelop-word "Begin" 0)
(re-search-forward (concat "[" scribe-open-parentheses "]")))
(defun scribe-end ()
(interactive)
(insert "\n")
(forward-char -1)
(scribe-envelop-word "End" 0)
(re-search-forward (concat "[" scribe-open-parentheses "]")))
(defun scribe-chapter ()
(interactive)
(insert "\n")
(forward-char -1)
(scribe-envelop-word "Chapter" 0)
(re-search-forward (concat "[" scribe-open-parentheses "]")))
(defun scribe-section ()
(interactive)
(insert "\n")
(forward-char -1)
(scribe-envelop-word "Section" 0)
(re-search-forward (concat "[" scribe-open-parentheses "]")))
(defun scribe-subsection ()
(interactive)
(insert "\n")
(forward-char -1)
(scribe-envelop-word "SubSection" 0)
(re-search-forward (concat "[" scribe-open-parentheses "]")))
(defun scribe-bracket-region-be (env min max)
(interactive "sEnvironment: \nr")
(save-excursion
(goto-char max)
(insert "@end(" env ")\n")
(goto-char min)
(insert "@begin(" env ")\n")))
(defun scribe-insert-environment (env)
(interactive "sEnvironment: ")
(scribe-bracket-region-be env (point) (point))
(forward-line 1)
(insert ?\n)
(forward-char -1))
(defun scribe-insert-quote (count)
"Insert \\=`\\=`, \\='\\=' or \" according to preceding character.
If `scribe-electric-quote' is non-nil, insert \\=`\\=`, \\='\\=' or \" according
to preceding character. With numeric arg N, always insert N \" characters.
Else just insert \"."
(interactive "P")
(if (or count (not scribe-electric-quote))
(self-insert-command (prefix-numeric-value count))
(let (lastfore lastback lastquote)
(insert
(cond
((= (preceding-char) ?\\) ?\")
((bobp) "``")
(t
(setq lastfore (save-excursion (and (search-backward
"``" (- (point) 1000) t)
(point)))
lastback (save-excursion (and (search-backward
"''" (- (point) 1000) t)
(point)))
lastquote (save-excursion (and (search-backward
"\"" (- (point) 100) t)
(point))))
(if (not lastquote)
(cond ((not lastfore) "``")
((not lastback) "''")
((> lastfore lastback) "''")
(t "``"))
(cond ((and (not lastback) (not lastfore)) "\"")
((and lastback (not lastfore) (> lastquote lastback)) "\"")
((and lastback (not lastfore) (> lastback lastquote)) "``")
((and lastfore (not lastback) (> lastquote lastfore)) "\"")
((and lastfore (not lastback) (> lastfore lastquote)) "''")
((and (> lastquote lastfore) (> lastquote lastback)) "\"")
((> lastfore lastback) "''")
(t "``")))))))))
(defun scribe-parenthesis (count)
"If scribe-electric-parenthesis is non-nil, insertion of an open-parenthesis
character inserts the following close parenthesis character if the
preceding text is of the form @Command."
(interactive "P")
(self-insert-command (prefix-numeric-value count))
(let (at-command paren-char point-save)
(if (or count (not scribe-electric-parenthesis))
nil
(save-excursion
(forward-char -1)
(setq point-save (point))
(skip-chars-backward (concat "^ \n\t\f" scribe-open-parentheses))
(setq at-command (and (equal (following-char) ?@)
(/= (point) (1- point-save)))))
(if (and at-command
(setq paren-char
(string-match (regexp-quote
(char-to-string (preceding-char)))
scribe-open-parentheses)))
(save-excursion
(insert (aref scribe-close-parentheses paren-char)))))))
(provide 'scribe)
;;; scribe.el ends here

171
lisp/obsolete/spell.el
View file

@ -1,171 +0,0 @@
;;; spell.el --- spelling correction interface for Emacs
;; Copyright (C) 1985, 2001-2017 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: wp, unix
;; Obsolete-since: 23.1
;; (not in obsolete/ directory then, but all functions marked obsolete)
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This mode provides an Emacs interface to the UNIX spell(1) program.
;; Entry points are `spell-buffer', `spell-word', `spell-region' and
;; `spell-string'.
;; See also ispell.el for an interface to the ispell program.
;;; Code:
(defgroup spell nil
"Interface to the UNIX spell(1) program."
:prefix "spell-"
:group 'applications)
(defcustom spell-command "spell"
"Command to run the spell program."
:type 'string
:group 'spell)
(defcustom spell-filter nil
"Filter function to process text before passing it to spell program.
This function might remove text-processor commands.
nil means don't alter the text before checking it."
:type '(choice (const nil) function)
:group 'spell)
;;;###autoload
(put 'spell-filter 'risky-local-variable t)
;;;###autoload
(defun spell-buffer ()
"Check spelling of every word in the buffer.
For each incorrect word, you are asked for the correct spelling
and then put into a query-replace to fix some or all occurrences.
If you do not want to change a word, just give the same word
as its \"correct\" spelling; then the query replace is skipped."
(interactive)
;; Don't warn about spell-region being obsolete.
(with-no-warnings
(spell-region (point-min) (point-max) "buffer")))
;;;###autoload
(make-obsolete 'spell-buffer 'ispell-buffer "23.1")
;;;###autoload
(defun spell-word ()
"Check spelling of word at or before point.
If it is not correct, ask user for the correct spelling
and `query-replace' the entire buffer to substitute it."
(interactive)
(let (beg end spell-filter)
(save-excursion
(if (not (looking-at "\\<"))
(forward-word -1))
(setq beg (point))
(forward-word 1)
(setq end (point)))
;; Don't warn about spell-region being obsolete.
(with-no-warnings
(spell-region beg end (buffer-substring beg end)))))
;;;###autoload
(make-obsolete 'spell-word 'ispell-word "23.1")
;;;###autoload
(defun spell-region (start end &optional description)
"Like `spell-buffer' but applies only to region.
Used in a program, applies from START to END.
DESCRIPTION is an optional string naming the unit being checked:
for example, \"word\"."
(interactive "r")
(let ((filter spell-filter)
(buf (get-buffer-create " *temp*")))
(with-current-buffer buf
(widen)
(erase-buffer))
(message "Checking spelling of %s..." (or description "region"))
(if (and (null filter) (= ?\n (char-after (1- end))))
(if (string= "spell" spell-command)
(call-process-region start end "spell" nil buf)
(call-process-region start end shell-file-name
nil buf nil "-c" spell-command))
(let ((oldbuf (current-buffer)))
(with-current-buffer buf
(insert-buffer-substring oldbuf start end)
(or (bolp) (insert ?\n))
(if filter (funcall filter))
(if (string= "spell" spell-command)
(call-process-region (point-min) (point-max) "spell" t buf)
(call-process-region (point-min) (point-max) shell-file-name
t buf nil "-c" spell-command)))))
(message "Checking spelling of %s...%s"
(or description "region")
(if (with-current-buffer buf
(> (buffer-size) 0))
"not correct"
"correct"))
(let (word newword
(case-fold-search t)
(case-replace t))
(while (with-current-buffer buf
(> (buffer-size) 0))
(with-current-buffer buf
(goto-char (point-min))
(setq word (downcase
(buffer-substring (point)
(progn (end-of-line) (point)))))
(forward-char 1)
(delete-region (point-min) (point))
(setq newword
(read-string (concat "`" word
"' not recognized; edit a replacement: ")
word))
(flush-lines (concat "^" (regexp-quote word) "$")))
(if (not (equal word newword))
(progn
(goto-char (point-min))
(query-replace-regexp (concat "\\b" (regexp-quote word) "\\b")
newword)))))))
;;;###autoload
(make-obsolete 'spell-region 'ispell-region "23.1")
;;;###autoload
(defun spell-string (string)
"Check spelling of string supplied as argument."
(interactive "sSpell string: ")
(with-temp-buffer
(widen)
(erase-buffer)
(insert string "\n")
(if (string= "spell" spell-command)
(call-process-region (point-min) (point-max) "spell"
t t)
(call-process-region (point-min) (point-max) shell-file-name
t t nil "-c" spell-command))
(if (= 0 (buffer-size))
(message "%s is correct" string)
(goto-char (point-min))
(while (search-forward "\n" nil t)
(replace-match " "))
(message "%sincorrect" (buffer-substring 1 (point-max))))))
;;;###autoload
(make-obsolete 'spell-string "The `spell' package is obsolete - use `ispell'."
"23.1")
(provide 'spell)
;;; spell.el ends here

160
lisp/obsolete/swedish.el
View file

@ -1,160 +0,0 @@
;;; swedish.el --- miscellaneous functions for dealing with Swedish
;; Copyright (C) 1988, 2001-2017 Free Software Foundation, Inc.
;; Author: Howard Gayle
;; Maintainer: emacs-devel@gnu.org
;; Keywords: i18n
;; Obsolete-since: 22.1
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Fixme: Is this actually used? if so, it should be in language,
;; possibly as a feature property of Swedish, probably defining a
;; `swascii' coding system.
;;; Code:
;; Written by Howard Gayle. See case-table.el for details.
;; See iso-swed.el for a description of the character set.
(defvar mail-send-hook)
(defvar news-group-hook-alist)
(defvar news-inews-hook)
(defvar swedish-re
"[ \t\n]\\(och\\|att\\|en\\|{r\\|\\[R\\|p}\\|P\\]\\|som\\|det\\|av\\|den\\|f|r\\|F\\\\R\\)[ \t\n.,?!:;'\")}]"
"Regular expression for common Swedish words.")
(defvar swascii-to-8859-trans
(let ((string (make-string 256 ? ))
(i 0))
(while (< i 256)
(aset string i i)
(setq i (1+ i)))
(aset string ?\[ 196)
(aset string ?\] 197)
(aset string ?\\ 214)
(aset string ?^ 220)
(aset string ?\{ 228)
(aset string ?\} 229)
(aset string ?\` 233)
(aset string ?\| 246)
(aset string ?~ 252)
string)
"Trans table from SWASCII to 8859.")
; $ is not converted because it almost always means US
; dollars, not general currency sign. @ is not converted
; because it is more likely to be an at sign in a mail address
; than an E with acute accent.
(defun swascii-to-8859-buffer ()
"Convert characters in buffer from Swedish/Finnish-ascii to ISO 8859/1.
Works even on read-only buffers. `$' and `@' are not converted."
(interactive)
(let ((buffer-read-only nil))
(translate-region (point-min) (point-max) swascii-to-8859-trans)))
(defun swascii-to-8859-buffer-maybe ()
"Call swascii-to-8859-buffer if the buffer looks like Swedish-ascii.
Leaves point just after the word that looks Swedish."
(interactive)
(let ((case-fold-search t))
(if (re-search-forward swedish-re nil t)
(swascii-to-8859-buffer))))
(setq rmail-show-message-hook 'swascii-to-8859-buffer-maybe)
(setq news-group-hook-alist
(append '(("^swnet." . swascii-to-8859-buffer-maybe))
(bound-and-true-p news-group-hook-alist)))
(defvar 8859-to-swascii-trans
(let ((string (make-string 256 ? ))
(i 0))
(while (< i 256)
(aset string i i)
(setq i (1+ i)))
(aset string 164 ?$)
(aset string 196 ?\[)
(aset string 197 ?\])
(aset string 201 ?@)
(aset string 214 ?\\)
(aset string 220 ?^)
(aset string 228 ?\{)
(aset string 229 ?\})
(aset string 233 ?\`)
(aset string 246 ?\|)
(aset string 252 ?~)
string)
"8859 to SWASCII trans table.")
(defun 8859-to-swascii-buffer ()
"Convert characters in buffer from ISO 8859/1 to Swedish/Finnish-ascii."
(interactive "*")
(translate-region (point-min) (point-max) 8859-to-swascii-trans))
(setq mail-send-hook '8859-to-swascii-buffer)
(setq news-inews-hook '8859-to-swascii-buffer)
;; It's not clear what purpose is served by a separate
;; Swedish mode that differs from Text mode only in having
;; a separate abbrev table. Nothing says that the abbrevs you
;; define in Text mode have to be English!
;(defvar swedish-mode-abbrev-table nil
; "Abbrev table used while in swedish mode.")
;(define-abbrev-table 'swedish-mode-abbrev-table ())
;(defun swedish-mode ()
; "Major mode for editing Swedish text intended for humans to
;read. Special commands:\\{text-mode-map}
;Turning on swedish-mode calls the value of the variable
;text-mode-hook, if that value is non-nil."
; (interactive)
; (kill-all-local-variables)
; (use-local-map text-mode-map)
; (setq mode-name "Swedish")
; (setq major-mode 'swedish-mode)
; (setq local-abbrev-table swedish-mode-abbrev-table)
; (set-syntax-table text-mode-syntax-table)
; (run-mode-hooks 'text-mode-hook))
;(defun indented-swedish-mode ()
; "Major mode for editing indented Swedish text intended for
;humans to read.\\{indented-text-mode-map}
;Turning on indented-swedish-mode calls the value of the
;variable text-mode-hook, if that value is non-nil."
; (interactive)
; (kill-all-local-variables)
; (use-local-map text-mode-map)
; (define-abbrev-table 'swedish-mode-abbrev-table ())
; (setq local-abbrev-table swedish-mode-abbrev-table)
; (set-syntax-table text-mode-syntax-table)
; (make-local-variable 'indent-line-function)
; (setq indent-line-function 'indent-relative-maybe)
; (use-local-map indented-text-mode-map)
; (setq mode-name "Indented Swedish")
; (setq major-mode 'indented-swedish-mode)
; (run-mode-hooks 'text-mode-hook))
(provide 'swedish)
;;; swedish.el ends here

237
lisp/obsolete/sym-comp.el
View file

@ -1,237 +0,0 @@
;;; sym-comp.el --- mode-dependent symbol completion
;; Copyright (C) 2004, 2008-2017 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: extensions
;; URL: http://www.loveshack.ukfsn.org/emacs
;; Obsolete-since: 23.2
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This defines `symbol-complete', which is a generalization of the
;; old `lisp-complete-symbol'. It provides the following hooks to
;; allow major modes to set up completion appropriate for the mode:
;; `symbol-completion-symbol-function',
;; `symbol-completion-completions-function',
;; `symbol-completion-predicate-function',
;; `symbol-completion-transform-function'. Typically it is only
;; necessary for a mode to set
;; `symbol-completion-completions-function' locally and to bind
;; `symbol-complete' appropriately.
;; It's unfortunate that there doesn't seem to be a good way of
;; combining this with `complete-symbol'.
;; There is also `symbol-completion-try-complete', for use with
;; Hippie-exp.
;;; Code:
;;;; Mode-dependent symbol completion.
(defun symbol-completion-symbol ()
"Default `symbol-completion-symbol-function'.
Uses `current-word' with the buffer narrowed to the part before
point."
(save-restriction
;; Narrow in case point is in the middle of a symbol -- we want
;; just the preceding part.
(narrow-to-region (point-min) (point))
(current-word)))
(defvar symbol-completion-symbol-function 'symbol-completion-symbol
"Function to return a partial symbol before point for completion.
The value it returns should be a string (or nil).
Major modes may set this locally if the default isn't appropriate.
Beware: the length of the string STR returned need to be equal to the length
of text before point that's subject to completion. Typically, this amounts
to saying that STR is equal to
\(buffer-substring (- (point) (length STR)) (point)).")
(defvar symbol-completion-completions-function nil
"Function to return possible symbol completions.
It takes an argument which is the string to be completed and
returns a value suitable for the second argument of
`try-completion'. This value need not use the argument, i.e. it
may be all possible completions, such as `obarray' in the case of
Emacs Lisp.
Major modes may set this locally to allow them to support
`symbol-complete'. See also `symbol-completion-symbol-function',
`symbol-completion-predicate-function' and
`symbol-completion-transform-function'.")
(defvar symbol-completion-predicate-function nil
"If non-nil, function to return a predicate for selecting symbol completions.
The function gets two args, the positions of the beginning and
end of the symbol to be completed.
Major modes may set this locally if the default isn't
appropriate. This is a function returning a predicate so that
the predicate can be context-dependent, e.g. to select only
function names if point is at a function call position. The
function's args may be useful for determining the context.")
(defvar symbol-completion-transform-function nil
"If non-nil, function to transform symbols in the symbol-completion buffer.
E.g., for Lisp, it may annotate the symbol as being a function,
not a variable.
The function takes the symbol name as argument. If it needs to
annotate this, it should return a value suitable as an element of
the list passed to `display-completion-list'.
The predicate being used for selecting completions (from
`symbol-completion-predicate-function') is available
dynamically-bound as `symbol-completion-predicate' in case the
transform needs it.")
(defvar symbol-completion-predicate)
;;;###autoload
(defun symbol-complete (&optional predicate)
"Perform completion of the symbol preceding point.
This is done in a way appropriate to the current major mode,
perhaps by interrogating an inferior interpreter. Compare
`complete-symbol'.
If no characters can be completed, display a list of possible completions.
Repeating the command at that point scrolls the list.
When called from a program, optional arg PREDICATE is a predicate
determining which symbols are considered.
This function requires `symbol-completion-completions-function'
to be set buffer-locally. Variables `symbol-completion-symbol-function',
`symbol-completion-predicate-function' and
`symbol-completion-transform-function' are also consulted."
(interactive)
;; Fixme: Punt to `complete-symbol' in this case?
(unless (functionp symbol-completion-completions-function)
(error "symbol-completion-completions-function not defined"))
(let* ((pattern (or (funcall symbol-completion-symbol-function)
(error "No preceding symbol to complete")))
;; FIXME: We assume below that `pattern' holds the text just
;; before point. This is a problem in the way
;; symbol-completion-symbol-function was defined.
(predicate (or predicate
(if symbol-completion-predicate-function
(funcall symbol-completion-predicate-function
(- (point) (length pattern))
(point)))))
(completions (funcall symbol-completion-completions-function
pattern))
;; In case the transform needs to access it.
(symbol-completion-predicate predicate)
(completion-extra-properties
(if (functionp symbol-completion-transform-function)
'(:annotation-function
(lambda (str)
(car-safe (cdr-safe
(funcall symbol-completion-transform-function
str))))))))
(completion-in-region (- (point) (length pattern)) (point)
completions predicate)))
(defvar he-search-string)
(defvar he-tried-table)
(defvar he-expand-list)
(declare-function he-init-string "hippie-exp" (beg end))
(declare-function he-string-member "hippie-exp" (str lst &optional trans-case))
(declare-function he-substitute-string "hippie-exp" (str &optional trans-case))
(declare-function he-reset-string "hippie-exp" ())
;;;###autoload
(defun symbol-completion-try-complete (old)
"Completion function for use with `hippie-expand'.
Uses `symbol-completion-symbol-function' and
`symbol-completion-completions-function'. It is intended to be
used something like this in a major mode which provides symbol
completion:
(if (featurep \\='hippie-exp)
(set (make-local-variable \\='hippie-expand-try-functions-list)
(cons \\='symbol-completion-try-complete
hippie-expand-try-functions-list)))"
(when (and symbol-completion-symbol-function
symbol-completion-completions-function)
(unless old
(let ((symbol (funcall symbol-completion-symbol-function)))
(he-init-string (- (point) (length symbol)) (point))
(if (not (he-string-member he-search-string he-tried-table))
(push he-search-string he-tried-table))
(setq he-expand-list
(and symbol
(funcall symbol-completion-completions-function symbol)))))
(while (and he-expand-list
(he-string-member (car he-expand-list) he-tried-table))
(pop he-expand-list))
(if he-expand-list
(progn
(he-substitute-string (pop he-expand-list))
t)
(if old (he-reset-string))
nil)))
;;; Emacs Lisp symbol completion.
(defun lisp-completion-symbol ()
"`symbol-completion-symbol-function' for Lisp."
(let ((end (point))
(beg (with-syntax-table emacs-lisp-mode-syntax-table
(save-excursion
(backward-sexp 1)
(while (= (char-syntax (following-char)) ?\')
(forward-char 1))
(point)))))
(buffer-substring-no-properties beg end)))
(defun lisp-completion-predicate (beg end)
"`symbol-completion-predicate-function' for Lisp."
(save-excursion
(goto-char beg)
(if (not (eq (char-before) ?\())
(lambda (sym) ;why not just nil ? -sm
;To avoid interned symbols with
;no slots. -- fx
(or (boundp sym) (fboundp sym)
(symbol-plist sym)))
;; Looks like a funcall position. Let's double check.
(if (condition-case nil
(progn (up-list -2) (forward-char 1)
(eq (char-after) ?\())
(error nil))
;; If the first element of the parent list is an open
;; parenthesis we are probably not in a funcall position.
;; Maybe a `let' varlist or something.
nil
;; Else, we assume that a function name is expected.
'fboundp))))
(defun lisp-symbol-completion-transform ()
"`symbol-completion-transform-function' for Lisp."
(lambda (elt)
(if (and (not (eq 'fboundp symbol-completion-predicate))
(fboundp (intern elt)))
(list elt " <f>")
elt)))
(provide 'sym-comp)
;;; sym-comp.el ends here