mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-10 15:56:18 +00:00
Code Issues Releases Activity

entered into RCS

Browse Source
This commit is contained in:
Richard M. Stallman 1993-01-08 15:12:37 +00:00
parent ce7385cb60
commit 2e9c66ab52
2 changed files with 332 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

134
lisp/sc-alist.el Normal file
View File

@ -0,0 +1,134 @@
;; -*- Mode: Emacs-Lisp -*-
;; sc-alist.el -- Version 1.0 (used to be baw-alist.el)
;; association list utilities providing insertion, deletion, sorting
;; fetching off key-value pairs in association lists.
;; ========== Disclaimer ==========
;; This software is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY. No author or distributor accepts
;; responsibility to anyone for the consequences of using it or for
;; whether it serves any particular purpose or works at all, unless he
;; says so in writing.
;; This software was written as part of the supercite author's
;; official duty as an employee of the United States Government and is
;; thus in the public domain. You are free to use that particular
;; software as you wish, but WITHOUT ANY WARRANTY WHATSOEVER. It
;; would be nice, though if when you use any of this code, you give
;; due credit to the author.
;; ========== Author (unless otherwise stated) ========================
;; NAME: Barry A. Warsaw USMAIL: Century Computing, Inc.
;; TELE: (301) 593-3330 1014 West Street
;; INET: bwarsaw@cen.com Laurel, Md 20707
;; UUCP: uunet!cen.com!bwarsaw
;;
(provide 'sc-alist)
(defun asort (alist-symbol key)
"Move a specified key-value pair to the head of an alist.
The alist is referenced by ALIST-SYMBOL. Key-value pair to move to
head is one matching KEY. Returns the sorted list and doesn't affect
the order of any other key-value pair. Side effect sets alist to new
sorted list."
(set alist-symbol
(sort (copy-alist (eval alist-symbol))
(function (lambda (a b) (equal (car a) key))))))
(defun aelement (key value)
"Makes a list of a cons cell containing car of KEY and cdr of VALUE.
The returned list is suitable as an element of an alist."
(list (cons key value)))
(defun aheadsym (alist)
"Return the key symbol at the head of ALIST."
(car (car alist)))
(defun anot-head-p (alist key)
"Find out if a specified key-value pair is not at the head of an alist.
The alist to check is specified by ALIST and the key-value pair is the
one matching the supplied KEY. Returns nil if ALIST is nil, or if
key-value pair is at the head of the alist. Returns t if key-value
pair is not at the head of alist. ALIST is not altered."
(not (equal (aheadsym alist) key)))
(defun aput (alist-symbol key &optional value)
"Inserts a key-value pair into an alist.
The alist is referenced by ALIST-SYMBOL. The key-value pair is made
from KEY and optionally, VALUE. Returns the altered alist or nil if
ALIST is nil.
If the key-value pair referenced by KEY can be found in the alist, and
VALUE is supplied non-nil, then the value of KEY will be set to VALUE.
If VALUE is not supplied, or is nil, the key-value pair will not be
modified, but will be moved to the head of the alist. If the key-value
pair cannot be found in the alist, it will be inserted into the head
of the alist (with value nil if VALUE is nil or not supplied)."
(let ((elem (aelement key value))
alist)
(asort alist-symbol key)
(setq alist (eval alist-symbol))
(cond ((null alist) (set alist-symbol elem))
((anot-head-p alist key) (set alist-symbol (nconc elem alist)))
(value (setcar alist (car elem)))
(t alist))))
(defun adelete (alist-symbol key)
"Delete a key-value pair from the alist.
Alist is referenced by ALIST-SYMBOL and the key-value pair to remove
is pair matching KEY. Returns the altered alist."
(asort alist-symbol key)
(let ((alist (eval alist-symbol)))
(cond ((null alist) nil)
((anot-head-p alist key) alist)
(t (set alist-symbol (cdr alist))))))
(defun aget (alist key &optional keynil-p)
"Returns the value in ALIST that is associated with KEY.
Optional KEYNIL-P describes what to do if the value associated with
KEY is nil. If KEYNIL-P is not supplied or is nil, and the value is
nil, then KEY is returned. If KEYNIL-P is non-nil, then nil would be
returned.
If no key-value pair matching KEY could be found in ALIST, or ALIST is
nil then nil is returned. ALIST is not altered."
(let ((copy (copy-alist alist)))
(cond ((null alist) nil)
((progn (asort 'copy key)
(anot-head-p copy key)) nil)
((cdr (car copy)))
(keynil-p nil)
((car (car copy)))
(t nil))))
(defun amake (alist-symbol keylist &optional valuelist)
"Make an association list.
The association list is attached to the alist referenced by
ALIST-SYMBOL. Each element in the KEYLIST becomes a key and is
associated with the value in VALUELIST with the same index. If
VALUELIST is not supplied or is nil, then each key in KEYLIST is
associated with nil.
KEYLIST and VALUELIST should have the same number of elements, but
this isn't enforced. If VALUELIST is smaller than KEYLIST, remaining
keys are associated with nil. If VALUELIST is larger than KEYLIST,
extra values are ignored. Returns the created alist."
(let ((keycar (car keylist))
(keycdr (cdr keylist))
(valcar (car valuelist))
(valcdr (cdr valuelist)))
(cond ((null keycdr)
(aput alist-symbol keycar valcar))
(t
(amake alist-symbol keycdr valcdr)
(aput alist-symbol keycar valcar))))
(eval alist-symbol))

198
lisp/sc.elec.el Normal file
View File

@ -0,0 +1,198 @@
;; -*- Mode: Emacs-Lisp -*-
;; sc-elec.el -- Version 2.3
;; ========== Introduction ==========
;; This file contains sc-electric mode for viewing reference headers.
;; It is loaded automatically by supercite.el when needed.
;; ========== Disclaimer ==========
;; This software is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY. No author or distributor accepts
;; responsibility to anyone for the consequences of using it or for
;; whether it serves any particular purpose or works at all, unless he
;; says so in writing.
;; Some of this software was written as part of the supercite author's
;; official duty as an employee of the United States Government and is
;; thus in the public domain. You are free to use that particular
;; software as you wish, but WITHOUT ANY WARRANTY WHATSOEVER. It
;; would be nice, though if when you use any of this code, you give
;; due credit to the author.
;; Other parts of this code were written by other people. Wherever
;; possible, credit to that author, and the copy* notice supplied by
;; the author are included with that code. In all cases, the spirit,
;; if not the letter of the GNU General Public Licence applies.
;; ========== Author (unless otherwise stated) ==========
;; NAME: Barry A. Warsaw USMAIL: Century Computing, Inc.
;; TELE: (301) 593-3330 1014 West Street
;; UUCP: uunet!cen.com!bwarsaw Laurel, MD 20707
;; INET: bwarsaw@cen.com
;; Want to be on the Supercite mailing list?
;;
;; Send articles to:
;; INET: supercite@anthem.nlm.nih.gov
;; UUCP: uunet!anthem.nlm.nih.gov!supercite
;;
;; Send administrivia (additions/deletions to list, etc) to:
;; INET: supercite-request@anthem.nlm.nih.gov
;; UUCP: uunet!anthem.nlm.nih.gov!supercite-request
;;
(provide 'sc-elec)
;; ======================================================================
;; set up vars for major mode
(defconst sc-electric-bufname "*sc-erefs*"
"*Supercite's electric buffer name.")
(defvar sc-electric-mode-hook nil
"*Hook for sc-electric-mode.")
;; ======================================================================
;; sc-electric-mode
(defun sc-electric-mode (&optional arg)
"Quasi major mode for viewing supercite reference headers.
Commands are: \\{sc-electric-mode-map}
Sc-electric-mode is not intended to be run interactively, but rather
accessed through supercite's electric reference feature. See
sc-insert-reference for more details. Optional ARG is the initial
header style to use, unless not supplied or invalid, in which case
sc-preferred-header-style is used."
(let ((gal sc-gal-information)
(sc-eref-style (if arg ;; assume passed arg is okay
arg
(if (and (natnump sc-preferred-header-style)
(sc-valid-index-p sc-preferred-header-style))
sc-preferred-header-style
0))))
(get-buffer-create sc-electric-bufname)
;; set up buffer and enter command loop
(save-excursion
(save-window-excursion
(pop-to-buffer sc-electric-bufname)
(kill-all-local-variables)
(setq sc-gal-information gal
buffer-read-only t
mode-name "Supercite-Electric-References"
major-mode 'sc-electric-mode)
(use-local-map sc-electric-mode-map)
(sc-eref-show sc-eref-style)
(run-hooks 'sc-electric-mode-hook)
(recursive-edit)
))
(if sc-eref-style
(condition-case nil
(eval (nth sc-eref-style sc-rewrite-header-list))
(error nil)
))
;; now restore state
(kill-buffer sc-electric-bufname)
))
;; ======================================================================
;; functions for electric mode
(defun sc-eref-index (index)
"Check INDEX to be sure it is a valid index into sc-rewrite-header-list.
If sc-electric-circular-p is non-nil, then list is considered circular
so that movement across the ends of the list wraparound."
(let ((last (1- (length sc-rewrite-header-list))))
(cond ((sc-valid-index-p index) index)
((< index 0)
(if sc-electric-circular-p last
(progn (error "No preceding reference headers in list.") 0)))
((> index last)
(if sc-electric-circular-p 0
(progn (error "No following reference headers in list.") last)))
)
))
(defun sc-eref-show (index)
"Show reference INDEX in sc-rewrite-header-list."
(setq sc-eref-style (sc-eref-index index))
(save-excursion
(set-buffer sc-electric-bufname)
(let ((ref (nth sc-eref-style sc-rewrite-header-list))
(buffer-read-only nil))
(erase-buffer)
(goto-char (point-min))
(condition-case err
(progn
(set-mark (point-min))
(eval ref)
(message "Showing reference header %d." sc-eref-style)
(goto-char (point-max))
)
(void-function
(progn (message
"Symbol's function definition is void: %s (Header %d)"
(symbol-name (car (cdr err)))
sc-eref-style)
(beep)
))
))))
;; ======================================================================
;; interactive commands
(defun sc-eref-next ()
"Display next reference in other buffer."
(interactive)
(sc-eref-show (1+ sc-eref-style)))
(defun sc-eref-prev ()
"Display previous reference in other buffer."
(interactive)
(sc-eref-show (1- sc-eref-style)))
(defun sc-eref-setn ()
"Set reference header selected as preferred."
(interactive)
(setq sc-preferred-header-style sc-eref-style)
(message "Preferred reference style set to header %d." sc-eref-style))
(defun sc-eref-goto (refnum)
"Show reference style indexed by REFNUM.
If REFNUM is an invalid index, don't go to that reference and return
nil."
(interactive "NGoto Reference: ")
(if (sc-valid-index-p refnum)
(sc-eref-show refnum)
(error "Invalid reference: %d. (Range: [%d .. %d])"
refnum 0 (1- (length sc-rewrite-header-list)))
))
(defun sc-eref-jump ()
"Set reference header to preferred header."
(interactive)
(sc-eref-show sc-preferred-header-style))
(defun sc-eref-abort ()
"Exit from electric reference mode without inserting reference."
(interactive)
(setq sc-eref-style nil)
(exit-recursive-edit))
(defun sc-eref-exit ()
"Exit from electric reference mode and insert selected reference."
(interactive)
(exit-recursive-edit))