bard@THEORY.LCS.MIT.EDU (01/29/89)
Here's pos-help.el, a variation on the help commands using the
window-configuration save and undo commands I sent around a few days ago in
positions.el. The basic idea is that you should be able to use a help
command, and then get the old window configuration back. Help used to use an
approximation of that; now it uses a better approximation which doesn't screw
up if you have two windows on the same buffer at different places.
Other people are encouraged to make similar changes to other commands which
fiddle with windows.
-- Bard the (function (lambda (x) (gargoyle)))
;; Help commands for Emacs
;; Copyright (C) 1985, 1986, 1989 Free Software Foundation, Inc.
;; Hacked up by Bard Bloom 1/26/88:
;; (File is called pos-help.el at the moment)
;; - Takes advantage of my Positions package, in particular the
;; window-undo command will remove the *Help* window and restore
;; the old screen.
;; - Uses View mode in the help window
;; - If the variable help-create-new-buffers is true,
;; it creates a new buffer rather than reusing *Help* all the time.
;; There is a function m-x help-toggle-create which toggles this variable.
;; The buffers are named `=stuff-you-wanted-help-about='; I chose
;; "="s because they're easy to type and won't usually interfere
;; with buffer name completion because nothing standard starts with "=".
;; - m-x help-clean-up gets rid of all those buffers.
;; This file is part of GNU Emacs.
;; GNU Emacs 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. Refer to the GNU Emacs General Public
;; License for full details.
;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License. A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities. It should be in a
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
(require 'positions)
(defvar help-map (make-sparse-keymap)
"Keymap for characters following the Help key.")
(define-key global-map "\C-h" 'help-command)
(fset 'help-command help-map)
(define-key help-map "\C-h" 'help-for-help)
(define-key help-map "?" 'help-for-help)
(define-key help-map "\C-c" 'describe-copying)
(define-key help-map "\C-d" 'describe-distribution)
(define-key help-map "\C-w" 'describe-no-warranty)
(define-key help-map "a" 'command-apropos)
(define-key help-map "b" 'describe-bindings)
(define-key help-map "c" 'describe-key-briefly)
(define-key help-map "k" 'describe-key)
(define-key help-map "d" 'describe-function)
(define-key help-map "f" 'describe-function)
(define-key help-map "i" 'info)
(define-key help-map "l" 'view-lossage)
(define-key help-map "m" 'describe-mode)
(define-key help-map "\C-n" 'view-emacs-news)
(define-key help-map "n" 'view-emacs-news)
(define-key help-map "s" 'describe-syntax)
(define-key help-map "t" 'help-with-tutorial)
(define-key help-map "w" 'where-is)
(define-key help-map "v" 'describe-variable)
(defvar help-create-new-buffers nil
"*If true, each Help command creates a new buffer (so that you keep all
your old helps around until you get rid of them).")
(defvar help-created-buffers-list nil
"List of all the buffer-names that the help functions have created.")
(defun help-toggle-create ()
"Toggles the creation/reuse of help buffers. See
with-output-to-help-buffer for details."
(interactive)
(setq help-create-new-buffers (not help-create-new-buffers))
(message "Help will %screate new buffers."
(if help-create-new-buffers "" "not ")))
(defun help-clean-up ()
"Removes all the buffers created by the help functions (except *Help*)."
(interactive)
(dolist (bn help-created-buffers-list)
(when (get-buffer bn)
(kill-buffer bn)))
(setq help-created-buffers-list nil))
(defmacro with-output-to-help-buffer (help-about &rest code)
"Run CODE with-output-to-temp-buffer named *Help*.
Saves the initial window configuration so that window-undo
undoes it. Puts the help buffer in View mode. If the variable
help-create-new-buffers is true, this creates a new buffer
for each help-command."
(let ((bn (if help-create-new-buffers
(concat "=" (eval help-about) "=")
"*Help*")))
(when help-create-new-buffers
(push bn help-created-buffers-list))
(`
(progn
(stack-save-current-wc-pos)
(with-output-to-temp-buffer (, bn)
(,@ code))
(save-window-excursion
(pop-to-buffer (, bn))
(view-buffer (, bn)))))))
(defun help-with-tutorial ()
"Select the Emacs learn-by-doing tutorial."
(interactive)
(let ((file (expand-file-name "~/TUTORIAL")))
(delete-other-windows)
(if (get-file-buffer file)
(switch-to-buffer (get-file-buffer file))
(switch-to-buffer (create-file-buffer "~/TUTORIAL"))
(setq buffer-file-name file)
(setq default-directory (expand-file-name "~/"))
(setq auto-save-file-name nil)
(insert-file-contents (expand-file-name "TUTORIAL" exec-directory))
(goto-char (point-min))
(search-forward "\n<<")
(beginning-of-line)
(delete-region (point) (progn (end-of-line) (point)))
(newline (- (window-height (selected-window))
(count-lines (point-min) (point))
6))
(goto-char (point-min))
(set-buffer-modified-p nil))))
(defun describe-key-briefly (key)
"Print the name of the function KEY invokes. KEY is a string."
(interactive "kDescribe key briefly: ")
(let ((defn (key-binding key)))
(if (or (null defn) (integerp defn))
(message "%s is undefined" (key-description key))
(message "%s runs the command %s"
(key-description key)
(if (symbolp defn) defn (prin1-to-string defn))))))
(defun print-help-return-message (&optional function)
"Display or return message saying how to restore windows after help command.
Computes a message and applies the argument FUNCTION to it.
If FUNCTION is nil, applies `message' to it, thus printing it."
(and (not (get-buffer-window standard-output))
(funcall (or function 'message)
(substitute-command-keys
"Type \\[window-undo] to restore windows."))))
(defun describe-key (key)
"Display documentation of the function KEY invokes. KEY is a string."
(interactive "kDescribe key: ")
(let ((defn (key-binding key)))
(if (or (null defn) (integerp defn))
(message "%s is undefined" (key-description key))
(with-output-to-help-buffer (key-description key)
(prin1 defn)
(princ ":\n")
(if (documentation defn)
(princ (documentation defn))
(princ "not documented"))
(print-help-return-message)))))
(defun describe-mode ()
"Display documentation of current major mode."
(interactive)
(with-output-to-help-buffer mode-name
(princ mode-name)
(princ " Mode:\n")
(princ (documentation major-mode))
(print-help-return-message)))
(defun describe-distribution ()
"Display info on how to obtain the latest version of GNU Emacs."
(interactive)
(find-file-read-only
(expand-file-name "DISTRIB" exec-directory)))
(defun describe-copying ()
"Display info on how you may redistribute copies of GNU Emacs."
(interactive)
(find-file-read-only
(expand-file-name "COPYING" exec-directory))
(goto-char (point-min)))
(defun describe-no-warranty ()
"Display info on all the kinds of warranty Emacs does NOT have."
(interactive)
(describe-copying)
(let (case-fold-search)
(search-forward "NO WARRANTY")
(recenter 0)))
(defun view-emacs-news ()
"Display info on recent changes to Emacs."
(interactive)
(find-file-read-only (expand-file-name "NEWS" exec-directory)))
(defun view-lossage ()
"Display last 100 input keystrokes."
(interactive)
(with-output-to-help-buffer "Lossage"
(princ (key-description (recent-keys)))
(save-excursion
(set-buffer standard-output)
(goto-char (point-min))
(while (progn (move-to-column 50) (not (eobp)))
(search-forward " " nil t)
(newline)))
(print-help-return-message)))
(defun help-for-help ()
"You have typed C-h, the help character. Type a Help option:
A command-apropos. Give a substring, and see a list of commands
(functions interactively callable) that contain
that substring. See also the apropos command.
B describe-bindings. Display table of all key bindings.
C describe-key-briefly. Type a command key sequence;
it prints the function name that sequence runs.
F describe-function. Type a function name and get documentation of it.
I info. The info documentation reader.
K describe-key. Type a command key sequence;
it displays the full documentation.
L view-lossage. Shows last 100 characters you typed.
M describe-mode. Print documentation of current major mode,
which describes the commands peculiar to it.
N view-emacs-news. Shows emacs news file.
S describe-syntax. Display contents of syntax table, plus explanations
T help-with-tutorial. Select the Emacs learn-by-doing tutorial.
V describe-variable. Type name of a variable;
it displays the variable's documentation and value.
W where-is. Type command name; it prints which keystrokes
invoke that command.
C-c print Emacs copying permission (General Public License).
C-d print Emacs ordering information.
C-n print news of recent Emacs changes.
C-w print information on absence of warranty for GNU Emacs."
(interactive)
(message
"A B C F I K L M N S T V W C-c C-d C-n C-w. Type C-h again for more help: ")
(let ((char (read-char)))
(if (or (= char ?\C-h) (= char ??))
(save-window-excursion
(switch-to-buffer "*Help*")
(erase-buffer)
(insert (documentation 'help-for-help))
(goto-char (point-min))
(while (memq char '(?\C-h ?? ?\C-v ?\ ?\177 ?\M-v))
(if (memq char '(?\C-v ?\ ))
(scroll-up))
(if (memq char '(?\177 ?\M-v))
(scroll-down))
(message "A B C F I K L M N S T V W C-c C-d C-n C-w%s: "
(if (pos-visible-in-window-p (point-max))
"" " or Space to scroll"))
(let ((cursor-in-echo-area t))
(setq char (read-char))))))
(let ((defn (cdr (assq (downcase char) (cdr help-map)))))
(if defn (call-interactively defn) (ding)))))
(defun function-called-at-point ()
(condition-case ()
(save-excursion
(save-restriction
(narrow-to-region (max (point-min) (- (point) 1000)) (point-max))
(backward-up-list 1)
(forward-char 1)
(let (obj)
(setq obj (read (current-buffer)))
(and (symbolp obj) (fboundp obj) obj))))
(error nil)))
(defun describe-function (function)
"Display the full documentation of FUNCTION (a symbol)."
(interactive
(let ((fn (function-called-at-point))
(enable-recursive-minibuffers t)
val)
(setq val (completing-read (if fn
(format "Describe function (default %s): " fn)
"Describe function: ")
obarray 'fboundp t))
(list (if (equal val "")
fn (intern val)))))
(with-output-to-help-buffer (symbol-name function)
(prin1 function)
(princ ":
")
(if (documentation function)
(princ (documentation function))
(princ "not documented"))
(print-help-return-message)))
(defun variable-at-point ()
(condition-case ()
(save-excursion
(forward-sexp -1)
(skip-chars-forward "'")
(let ((obj (read (current-buffer))))
(and (symbolp obj) (boundp obj) obj)))
(error nil)))
(defun describe-variable (variable)
"Display the full documentation of VARIABLE (a symbol)."
(interactive
(let ((v (variable-at-point))
(enable-recursive-minibuffers t)
val)
(setq val (completing-read (if v
(format "Describe variable (default %s): " v)
"Describe variable: ")
obarray 'boundp t))
(list (if (equal val "")
v (intern val)))))
(with-output-to-help-buffer (symbol-name variable)
(prin1 variable)
(princ "'s value is ")
(if (not (boundp variable))
(princ "void.")
(prin1 (symbol-value variable)))
(terpri) (terpri)
(princ "Documentation:")
(terpri)
(let ((doc (documentation-property variable 'variable-documentation)))
(if doc
(princ (substitute-command-keys doc))
(princ "not documented as a variable.")))
(print-help-return-message)))
(defun command-apropos (string)
"Like apropos but lists only symbols that are names of commands
\(interactively callable functions)."
(interactive "sCommand apropos (regexp): ")
(let ((message
(let ((standard-output (get-buffer-create "*Help*")))
(print-help-return-message 'identity))))
(apropos string 'commandp)
(and message (message message))))