changeset 1744:5180778aedcb

entered into RCS

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/=sc-alist.el	Fri Jan 08 15:12:37 1993 +0000
@@ -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: [phone]               1014 West Street
+;; INET: [e-mail]              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))

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/=sc-elec.el	Fri Jan 08 15:12:37 1993 +0000
@@ -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: [phone]                 1014 West Street
+;; UUCP: uunet!cen.com!bwarsaw          Laurel, MD 20707
+;; INET: [e-mail]                    
+
+;; Want to be on the Supercite mailing list?
+;;
+;; Send articles to:
+;;         INET: [e-mail]
+;;         UUCP: uunet!anthem.nlm.nih.gov!supercite
+;; 
+;; Send administrivia (additions/deletions to list, etc) to:
+;;         INET: [e-mail]
+;;         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))