lisp/sc.elec.el

   1 ;; -*- Mode: Emacs-Lisp -*-
   2 ;; sc-elec.el  --  Version 2.3
   3
   4 ;; ========== Introduction ==========
   5 ;; This file contains sc-electric mode for viewing reference headers.
   6 ;; It is loaded automatically by supercite.el when needed.
   7
   8 ;; ========== Disclaimer ==========
   9 ;; This software is distributed in the hope that it will be useful,
  10 ;; but WITHOUT ANY WARRANTY.  No author or distributor accepts
  11 ;; responsibility to anyone for the consequences of using it or for
  12 ;; whether it serves any particular purpose or works at all, unless he
  13 ;; says so in writing.
  14
  15 ;; Some of this software was written as part of the supercite author's
  16 ;; official duty as an employee of the United States Government and is
  17 ;; thus in the public domain.  You are free to use that particular
  18 ;; software as you wish, but WITHOUT ANY WARRANTY WHATSOEVER.  It
  19 ;; would be nice, though if when you use any of this code, you give
  20 ;; due credit to the author.
  21
  22 ;; Other parts of this code were written by other people.  Wherever
  23 ;; possible, credit to that author, and the copy* notice supplied by
  24 ;; the author are included with that code. In all cases, the spirit,
  25 ;; if not the letter of the GNU General Public Licence applies.
  26
  27 ;; ========== Author (unless otherwise stated) ==========
  28 ;; NAME: Barry A. Warsaw        USMAIL: Century Computing, Inc.
  29 ;; TELE: (301) 593-3330                 1014 West Street
  30 ;; UUCP: uunet!cen.com!bwarsaw          Laurel, MD 20707
  31 ;; INET: bwarsaw@cen.com
  32
  33 ;; Want to be on the Supercite mailing list?
  34 ;;
  35 ;; Send articles to:
  36 ;;         INET: supercite@anthem.nlm.nih.gov
  37 ;;         UUCP: uunet!anthem.nlm.nih.gov!supercite
  38 ;;
  39 ;; Send administrivia (additions/deletions to list, etc) to:
  40 ;;         INET: supercite-request@anthem.nlm.nih.gov
  41 ;;         UUCP: uunet!anthem.nlm.nih.gov!supercite-request
  42 ;;
  43 (provide 'sc-elec)
  44
  45
  46 ;; ======================================================================
  47 ;; set up vars for major mode
  48
  49 (defconst sc-electric-bufname "*sc-erefs*"
  50   "*Supercite's electric buffer name.")
  51
  52
  53 (defvar sc-electric-mode-hook nil
  54   "*Hook for sc-electric-mode.")
  55
  56
  57 \f
  58 ;; ======================================================================
  59 ;; sc-electric-mode
  60
  61 (defun sc-electric-mode (&optional arg)
  62   "Quasi major mode for viewing supercite reference headers.
  63 Commands are: \\{sc-electric-mode-map}
  64 Sc-electric-mode is not intended to be run interactively, but rather
  65 accessed through supercite's electric reference feature.  See
  66 sc-insert-reference for more details. Optional ARG is the initial
  67 header style to use, unless not supplied or invalid, in which case
  68 sc-preferred-header-style is used."
  69   (let ((gal sc-gal-information)
  70         (sc-eref-style (if arg  ;; assume passed arg is okay
  71                            arg
  72                          (if (and (natnump sc-preferred-header-style)
  73                                   (sc-valid-index-p sc-preferred-header-style))
  74                              sc-preferred-header-style
  75                            0))))
  76     (get-buffer-create sc-electric-bufname)
  77     ;; set up buffer and enter command loop
  78     (save-excursion
  79       (save-window-excursion
  80         (pop-to-buffer sc-electric-bufname)
  81         (kill-all-local-variables)
  82         (setq sc-gal-information gal
  83               buffer-read-only t
  84               mode-name "Supercite-Electric-References"
  85               major-mode 'sc-electric-mode)
  86         (use-local-map sc-electric-mode-map)
  87         (sc-eref-show sc-eref-style)
  88         (run-hooks 'sc-electric-mode-hook)
  89         (recursive-edit)
  90         ))
  91     (if sc-eref-style
  92         (condition-case nil
  93             (eval (nth sc-eref-style sc-rewrite-header-list))
  94           (error nil)
  95           ))
  96     ;; now restore state
  97     (kill-buffer sc-electric-bufname)
  98     ))
  99
 100
 101 \f
 102 ;; ======================================================================
 103 ;; functions for electric mode
 104
 105 (defun sc-eref-index (index)
 106   "Check INDEX to be sure it is a valid index into sc-rewrite-header-list.
 107 If sc-electric-circular-p is non-nil, then list is considered circular
 108 so that movement across the ends of the list wraparound."
 109   (let ((last (1- (length sc-rewrite-header-list))))
 110     (cond ((sc-valid-index-p index) index)
 111           ((< index 0)
 112            (if sc-electric-circular-p last
 113              (progn (error "No preceding reference headers in list.") 0)))
 114           ((> index last)
 115            (if sc-electric-circular-p 0
 116              (progn (error "No following reference headers in list.") last)))
 117           )
 118     ))
 119
 120
 121 (defun sc-eref-show (index)
 122   "Show reference INDEX in sc-rewrite-header-list."
 123   (setq sc-eref-style (sc-eref-index index))
 124   (save-excursion
 125     (set-buffer sc-electric-bufname)
 126     (let ((ref (nth sc-eref-style sc-rewrite-header-list))
 127           (buffer-read-only nil))
 128       (erase-buffer)
 129       (goto-char (point-min))
 130       (condition-case err
 131           (progn
 132             (set-mark (point-min))
 133             (eval ref)
 134             (message "Showing reference header %d." sc-eref-style)
 135             (goto-char (point-max))
 136             )
 137         (void-function
 138          (progn (message
 139                  "Symbol's function definition is void: %s (Header %d)"
 140                  (symbol-name (car (cdr err)))
 141                  sc-eref-style)
 142                 (beep)
 143                 ))
 144         ))))
 145
 146
 147 \f
 148 ;; ======================================================================
 149 ;; interactive commands
 150
 151 (defun sc-eref-next ()
 152   "Display next reference in other buffer."
 153   (interactive)
 154   (sc-eref-show (1+ sc-eref-style)))
 155
 156
 157 (defun sc-eref-prev ()
 158   "Display previous reference in other buffer."
 159   (interactive)
 160   (sc-eref-show (1- sc-eref-style)))
 161
 162
 163 (defun sc-eref-setn ()
 164   "Set reference header selected as preferred."
 165   (interactive)
 166   (setq sc-preferred-header-style sc-eref-style)
 167   (message "Preferred reference style set to header %d." sc-eref-style))
 168
 169
 170 (defun sc-eref-goto (refnum)
 171   "Show reference style indexed by REFNUM.
 172 If REFNUM is an invalid index, don't go to that reference and return
 173 nil."
 174   (interactive "NGoto Reference: ")
 175   (if (sc-valid-index-p refnum)
 176       (sc-eref-show refnum)
 177     (error "Invalid reference: %d. (Range: [%d .. %d])"
 178            refnum 0 (1- (length sc-rewrite-header-list)))
 179     ))
 180
 181
 182 (defun sc-eref-jump ()
 183   "Set reference header to preferred header."
 184   (interactive)
 185   (sc-eref-show sc-preferred-header-style))
 186
 187
 188 (defun sc-eref-abort ()
 189   "Exit from electric reference mode without inserting reference."
 190   (interactive)
 191   (setq sc-eref-style nil)
 192   (exit-recursive-edit))
 193
 194
 195 (defun sc-eref-exit ()
 196   "Exit from electric reference mode and insert selected reference."
 197   (interactive)
 198   (exit-recursive-edit))