home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / emacs-19.16 / lisp / sc-elec.el < prev    next >
Encoding:
Text File  |  1993-06-07  |  6.1 KB  |  199 lines
  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.  
  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.  
  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.  
  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))
  199.