Return to ehelp.el CVS log

Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp

Annotation of 43BSDReno/contrib/emacs-18.55/lisp/ehelp.el, revision 1.1

1.1     ! root        1: ;; Copyright (C) 1986 Free Software Foundation, Inc.
        !             2: 
        !             3: ;; This file is part of GNU Emacs.
        !             4: 
        !             5: ;; GNU Emacs is distributed in the hope that it will be useful,
        !             6: ;; but WITHOUT ANY WARRANTY.  No author or distributor
        !             7: ;; accepts responsibility to anyone for the consequences of using it
        !             8: ;; or for whether it serves any particular purpose or works at all,
        !             9: ;; unless he says so in writing.  Refer to the GNU Emacs General Public
        !            10: ;; License for full details.
        !            11: 
        !            12: ;; Everyone is granted permission to copy, modify and redistribute
        !            13: ;; GNU Emacs, but only under the conditions described in the
        !            14: ;; GNU Emacs General Public License.   A copy of this license is
        !            15: ;; supposed to have been given to you along with GNU Emacs so you
        !            16: ;; can know your rights and responsibilities.  It should be in a
        !            17: ;; file named COPYING.  Among other things, the copyright notice
        !            18: ;; and this notice must be preserved on all copies.
        !            19: 
        !            20: (require 'electric)
        !            21: (provide 'ehelp) 
        !            22: 
        !            23: (defvar electric-help-map ()
        !            24:   "Keymap defining commands available whilst scrolling
        !            25: through a buffer in electric-help-mode")
        !            26: 
        !            27: (put 'electric-help-undefined 'suppress-keymap t)
        !            28: (if electric-help-map
        !            29:     ()
        !            30:   (let ((map (make-keymap)))
        !            31:     (fillarray map 'electric-help-undefined)
        !            32:     (define-key map (char-to-string meta-prefix-char) (copy-keymap map))
        !            33:     (define-key map (char-to-string help-char) 'electric-help-help)
        !            34:     (define-key map "?" 'electric-help-help)
        !            35:     (define-key map " " 'scroll-up)
        !            36:     (define-key map "\^?" 'scroll-down)
        !            37:     (define-key map "." 'beginning-of-buffer)
        !            38:     (define-key map "<" 'beginning-of-buffer)
        !            39:     (define-key map ">" 'end-of-buffer)
        !            40:     ;(define-key map "\C-g" 'electric-help-exit)
        !            41:     (define-key map "q" 'electric-help-exit)
        !            42:     (define-key map "Q" 'electric-help-exit)
        !            43:     ;;a better key than this?
        !            44:     (define-key map "r" 'electric-help-retain)
        !            45: 
        !            46:     (setq electric-help-map map)))
        !            47:    
        !            48: (defun electric-help-mode ()
        !            49:   "with-electric-help temporarily places its buffer in this mode
        !            50: \(On exit from with-electric-help, the buffer is put in default-major-mode)"
        !            51:   (setq buffer-read-only t)
        !            52:   (setq mode-name "Help")
        !            53:   (setq major-mode 'help)
        !            54:   (setq mode-line-buffer-identification '(" Help:  %b"))
        !            55:   (use-local-map electric-help-map)
        !            56:   ;; this is done below in with-electric-help
        !            57:   ;(run-hooks 'electric-help-mode-hook)
        !            58:   )
        !            59: 
        !            60: (defun with-electric-help (thunk &optional buffer noerase)
        !            61:   "Arguments are THUNK &optional BUFFER NOERASE.
        !            62: BUFFER defaults to \"*Help*\"
        !            63: THUNK is a function of no arguments which is called to initialise
        !            64:  the contents of BUFFER.  BUFFER will be erased before THUNK is called unless
        !            65:  NOERASE is non-nil.  THUNK will be called with  standard-output  bound to
        !            66:  the buffer specified by BUFFER
        !            67: 
        !            68: After THUNK has been called, this function \"electrically\" pops up a window
        !            69: in which BUFFER is displayed and allows the user to scroll through that buffer
        !            70: in electric-help-mode.
        !            71: When the user exits (with electric-help-exit, or otherwise) the help
        !            72: buffer's window disappears (ie we use save-window-excursion)
        !            73: BUFFER is put into default-major-mode (or fundamental-mode) when we exit"
        !            74:   (setq buffer (get-buffer-create (or buffer "*Help*")))
        !            75:   (let ((one (one-window-p t))
        !            76:        (two nil))
        !            77:     (save-window-excursion
        !            78:       (save-excursion
        !            79:        (if one (goto-char (window-start (selected-window))))
        !            80:        (let ((pop-up-windows t))
        !            81:          (pop-to-buffer buffer))
        !            82:        (unwind-protect
        !            83:            (progn
        !            84:              (save-excursion
        !            85:                (set-buffer buffer)
        !            86:                (electric-help-mode)
        !            87:                (setq buffer-read-only nil)
        !            88:                (or noerase (erase-buffer)))
        !            89:              (let ((standard-output buffer))
        !            90:                (if (funcall thunk)
        !            91:                    ()
        !            92:                  (set-buffer buffer)
        !            93:                  (set-buffer-modified-p nil)
        !            94:                  (goto-char (point-min))
        !            95:                  (if one (shrink-window-if-larger-than-buffer (selected-window)))))
        !            96:              (set-buffer buffer)
        !            97:              (run-hooks 'electric-help-mode-hook)
        !            98:              (setq two (electric-help-command-loop))
        !            99:              (cond ((eq (car-safe two) 'retain)
        !           100:                     (setq two (vector (window-height (selected-window))
        !           101:                                       (window-start (selected-window))
        !           102:                                       (window-hscroll (selected-window))
        !           103:                                       (point))))
        !           104:                    (t (setq two nil))))
        !           105:                                  
        !           106:          (message "")
        !           107:          (set-buffer buffer)
        !           108:          (setq buffer-read-only nil)
        !           109:          (condition-case ()
        !           110:              (funcall (or default-major-mode 'fundamental-mode))
        !           111:            (error nil)))))
        !           112:     (if two
        !           113:        (let ((pop-up-windows t)
        !           114:              tem)
        !           115:          (pop-to-buffer buffer)
        !           116:          (setq tem (- (window-height (selected-window)) (elt two 0)))
        !           117:          (if (> tem 0) (shrink-window tem))
        !           118:          (set-window-start (selected-window) (elt two 1) t)
        !           119:          (set-window-hscroll (selected-window) (elt two 2))
        !           120:          (goto-char (elt two 3)))
        !           121:       ;;>> Perhaps this shouldn't be done.
        !           122:       ;; so that when we say "Press space to bury" we mean it
        !           123:       (replace-buffer-in-windows buffer)
        !           124:       ;; must do this outside of save-window-excursion
        !           125:       (bury-buffer buffer))))
        !           126: 
        !           127: (defun electric-help-command-loop ()
        !           128:   (catch 'exit
        !           129:     (if (pos-visible-in-window-p (point-max))
        !           130:        (progn (message "<<< Press Space to bury the help buffer >>>")
        !           131:               (if (= (setq unread-command-char (read-char)) ?\  )
        !           132:                   (progn (setq unread-command-char -1)
        !           133:                          (throw 'exit t)))))
        !           134:     (let (up down both neither
        !           135:          (standard (and (eq (key-binding " ")
        !           136:                             'scroll-up)
        !           137:                         (eq (key-binding "\^?")
        !           138:                             'scroll-down)
        !           139:                         (eq (key-binding "Q")
        !           140:                             'electric-help-exit)
        !           141:                         (eq (key-binding "q")
        !           142:                             'electric-help-exit))))
        !           143:       (Electric-command-loop
        !           144:         'exit
        !           145:        (function (lambda ()
        !           146:          (let ((min (pos-visible-in-window-p (point-min)))
        !           147:                (max (pos-visible-in-window-p (point-max))))
        !           148:            (cond ((and min max)
        !           149:                   (cond (standard "Press Q to exit ")
        !           150:                         (neither)
        !           151:                         (t (setq neither (substitute-command-keys "Press \\[scroll-up] to exit ")))))
        !           152:                  (min
        !           153:                   (cond (standard "Press SPC to scroll, Q to exit ")
        !           154:                         (up)
        !           155:                         (t (setq up (substitute-command-keys "Press \\[scroll-up] to scroll; \\[electric-help-exit] to exit ")))))
        !           156:                  (max
        !           157:                   (cond (standard "Press DEL to scroll back, Q to exit ")
        !           158:                         (down)
        !           159:                         (t (setq down (substitute-command-keys "Press \\[scroll-down] to scroll back, \\[scroll-up] to exit ")))))
        !           160:                  (t
        !           161:                   (cond (standard "Press SPC to scroll, DEL to scroll back, Q to exit ")
        !           162:                         (both)
        !           163:                         (t (setq both (substitute-command-keys "Press \\[scroll-up] to scroll, \\[scroll-down] to scroll back, \\[electric-help-exit] to exit ")))))))))
        !           164:                    t))))
        !           165: 
        !           166: 
        !           167: 
        !           168: ;(defun electric-help-scroll-up (arg)
        !           169: ;  ">>>Doc"
        !           170: ;  (interactive "P")
        !           171: ;  (if (and (null arg) (pos-visible-in-window-p (point-max)))
        !           172: ;      (electric-help-exit)
        !           173: ;    (scroll-up arg)))
        !           174: 
        !           175: (defun electric-help-exit ()
        !           176:   ">>>Doc"
        !           177:   (interactive)
        !           178:   (throw 'exit t))
        !           179: 
        !           180: (defun electric-help-retain ()
        !           181:   "Exit electric-help, retaining the current window/buffer conifiguration.
        !           182: \(The *Help* buffer will not be selected, but \\[switch-to-buffer-other-window] RET
        !           183: will select it.)"
        !           184:   (interactive)
        !           185:   (throw 'exit '(retain)))
        !           186: 
        !           187: 
        !           188: ;(defun electric-help-undefined ()
        !           189: ;  (interactive)
        !           190: ;  (let* ((keys (this-command-keys))
        !           191: ;       (n (length keys)))
        !           192: ;    (if (or (= n 1)
        !           193: ;          (and (= n 2)
        !           194: ;               meta-flag
        !           195: ;               (eq (aref keys 0) meta-prefix-char)))
        !           196: ;      (setq unread-command-char last-input-char
        !           197: ;            current-prefix-arg prefix-arg)
        !           198: ;      ;;>>> I don't care.
        !           199: ;      ;;>>> The emacs command-loop is too much pure pain to
        !           200: ;      ;;>>> duplicate
        !           201: ;      ))
        !           202: ;  (throw 'exit t))
        !           203: 
        !           204: (defun electric-help-undefined ()
        !           205:   (interactive)
        !           206:   (error "%s is undefined -- Press %s to exit"
        !           207:         (mapconcat 'single-key-description (this-command-keys) " ")
        !           208:         (if (eq (key-binding "Q") 'electric-help-exit)
        !           209:             "Q"
        !           210:           (substitute-command-keys "\\[electric-help-exit]"))))
        !           211: 
        !           212: 
        !           213: ;>>> this needs to be hairified (recursive help, anybody?)
        !           214: (defun electric-help-help ()
        !           215:   (interactive)
        !           216:   (if (and (eq (key-binding "Q") 'electric-help-exit)
        !           217:           (eq (key-binding " ") 'scroll-up)
        !           218:           (eq (key-binding "\^?") 'scroll-down))
        !           219:       (message "SPC scrolls forward, DEL scrolls back, Q exits and burys help buffer")
        !           220:     ;; to give something for user to look at while slow substitute-cmd-keys
        !           221:     ;;  grinds away
        !           222:     (message "Help...")
        !           223:     (message "%s" (substitute-command-keys "\\[scroll-up] scrolls forward, \\[scroll-down] scrolls back, \\[electric-help-exit] exits.")))
        !           224:   (sit-for 2))
        !           225: 
        !           226: 
        !           227: (defun electric-helpify (fun)
        !           228:   (let ((name "*Help*"))
        !           229:     (if (save-window-excursion
        !           230:          ;; kludge-o-rama
        !           231:          (let* ((p (symbol-function 'print-help-return-message))
        !           232:                 (b (get-buffer name))
        !           233:                 (m (buffer-modified-p b)))
        !           234:            (and b (not (get-buffer-window b))
        !           235:                 (setq b nil))
        !           236:            (unwind-protect
        !           237:                (progn
        !           238:                  (message "%s..." (capitalize (symbol-name fun)))
        !           239:                  ;; with-output-to-temp-buffer marks the buffer as unmodified.
        !           240:                  ;; kludging excessively and relying on that as some sort
        !           241:                  ;;  of indication leads to the following abomination...
        !           242:                  ;;>> This would be doable without such icky kludges if either
        !           243:                  ;;>> (a) there were a function to read the interactive
        !           244:                  ;;>>     args for a command and return a list of those args.
        !           245:                  ;;>>     (To which one would then just apply the command)
        !           246:                  ;;>>     (The only problem with this is that interactive-p
        !           247:                  ;;>>      would break, but that is such a misfeature in
        !           248:                  ;;>>      any case that I don't care)
        !           249:                  ;;>>     It is easy to do this for emacs-lisp functions;
        !           250:                  ;;>>     the only problem is getting the interactive spec
        !           251:                  ;;>>     for subrs
        !           252:                  ;;>> (b) there were a function which returned a
        !           253:                  ;;>>     modification-tick for a buffer.  One could tell
        !           254:                  ;;>>     whether a buffer had changed by whether the
        !           255:                  ;;>>     modification-tick were different.
        !           256:                  ;;>>     (Presumably there would have to be a way to either
        !           257:                  ;;>>      restore the tick to some previous value, or to
        !           258:                  ;;>>      suspend updating of the tick in order to allow
        !           259:                  ;;>>      things like momentary-string-display)
        !           260:                  (and b
        !           261:                       (save-excursion
        !           262:                         (set-buffer b)
        !           263:                         (set-buffer-modified-p t)))
        !           264:                  (fset 'print-help-return-message 'ignore)
        !           265:                  (call-interactively fun)
        !           266:                  (and (get-buffer name)
        !           267:                       (get-buffer-window (get-buffer name))
        !           268:                       (or (not b)
        !           269:                           (not (eq b (get-buffer name)))
        !           270:                           (not (buffer-modified-p b)))))
        !           271:              (fset 'print-help-return-message p)
        !           272:              (and b (buffer-name b)
        !           273:                   (save-excursion
        !           274:                     (set-buffer b)
        !           275:                     (set-buffer-modified-p m))))))
        !           276:        (with-electric-help 'ignore name t))))
        !           277: 
        !           278: 
        !           279: (defun electric-describe-key ()
        !           280:   (interactive)
        !           281:   (electric-helpify 'describe-key))
        !           282: 
        !           283: (defun electric-describe-mode ()
        !           284:   (interactive)
        !           285:   (electric-helpify 'describe-mode))
        !           286: 
        !           287: (defun electric-view-lossage ()
        !           288:   (interactive)
        !           289:   (electric-helpify 'view-lossage))
        !           290: 
        !           291: ;(defun electric-help-for-help ()
        !           292: ;  "See help-for-help"
        !           293: ;  (interactive)
        !           294: ;  )
        !           295: 
        !           296: (defun electric-describe-function ()
        !           297:   (interactive)
        !           298:   (electric-helpify 'describe-function))
        !           299: 
        !           300: (defun electric-describe-variable ()
        !           301:   (interactive)
        !           302:   (electric-helpify 'describe-variable))
        !           303: 
        !           304: (defun electric-describe-bindings ()
        !           305:   (interactive)
        !           306:   (electric-helpify 'describe-bindings))
        !           307: 
        !           308: (defun electric-describe-syntax ()
        !           309:   (interactive)
        !           310:   (electric-helpify 'describe-syntax))
        !           311: 
        !           312: (defun electric-command-apropos ()
        !           313:   (interactive)
        !           314:   (electric-helpify 'command-apropos))
        !           315: 
        !           316: ;(define-key help-map "a" 'electric-command-apropos)
        !           317: 
        !           318: 
        !           319: 
        !           320: 
        !           321: ;;;; ehelp-map
        !           322: 
        !           323: (defvar ehelp-map ())
        !           324: (if ehelp-map
        !           325:     nil
        !           326:   (let ((map (copy-keymap help-map))) 
        !           327:     (substitute-key-definition 'describe-key 'electric-describe-key map)
        !           328:     (substitute-key-definition 'describe-mode 'electric-describe-mode map)
        !           329:     (substitute-key-definition 'view-lossage 'electric-view-lossage map)
        !           330:     (substitute-key-definition 'describe-function 'electric-describe-function map)
        !           331:     (substitute-key-definition 'describe-variable 'electric-describe-variable map)
        !           332:     (substitute-key-definition 'describe-bindings 'electric-describe-bindings map)
        !           333:     (substitute-key-definition 'describe-syntax 'electric-describe-syntax map)
        !           334: 
        !           335:     (setq ehelp-map map)
        !           336:     (fset 'ehelp-command map)))
        !           337: 
        !           338: ;; Do (define-key global-map "\C-h" 'ehelp-command) if you want to win
        !           339: 

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.