Return to ehelp.el CVS log

Up to [Apple XNU] / GNUtools / emacs / lisp

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

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