1992-05-30 23:54:21 +00:00
;;; ehelp.el --- bindings for electric-help mode
2005-08-06 22:13:43 +00:00
;; Copyright (C) 1986, 1995, 2000, 2001, 2002, 2003, 2004,
2007-01-21 03:53:13 +00:00
;; 2005, 2006, 2007 Free Software Foundation, Inc.
1992-07-22 04:22:42 +00:00
1992-07-16 21:47:34 +00:00
;; Maintainer: FSF
1992-07-17 08:15:29 +00:00
;; Keywords: help, extensions
1992-07-16 21:47:34 +00:00
1989-10-31 16:00:07 +00:00
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
1992-07-16 21:47:34 +00:00
;; the Free Software Foundation; either version 2, or (at your option)
1989-10-31 16:00:07 +00:00
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
1996-01-14 07:34:30 +00:00
;; along with GNU Emacs; see the file COPYING. If not, write to the
2005-07-04 23:32:44 +00:00
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
1989-10-31 16:00:07 +00:00
1993-03-22 03:27:18 +00:00
;;; Commentary:
;; This package provides a pre-packaged `Electric Help Mode' for
;; browsing on-line help screens. There is one entry point,
1995-07-18 23:31:41 +00:00
;; `with-electric-help'; all you have to give it is a no-argument
1993-08-08 00:20:22 +00:00
;; function that generates the actual text of the help into the current
1993-03-22 03:27:18 +00:00
;; buffer.
1995-07-30 07:04:58 +00:00
;; To make this the default, you must do
;; (require 'ehelp)
;; (define-key global-map "\C-h" 'ehelp-command)
;; (define-key global-map [help] 'ehelp-command)
;; (define-key global-map [f1] 'ehelp-command)
1992-07-16 21:47:34 +00:00
;;; Code:
1989-10-31 16:00:07 +00:00
( require 'electric )
( defvar electric-help-map ( )
1991-02-28 21:40:18 +00:00
" Keymap defining commands available in `electric-help-mode' . " )
1989-10-31 16:00:07 +00:00
1996-02-03 03:18:00 +00:00
( defvar electric-help-form-to-execute nil )
2000-09-20 20:39:36 +00:00
( defgroup electric-help ( )
" Electric help facility. "
:version " 21.1 "
:group 'help )
( defcustom electric-help-shrink-window t
" If set, adjust help window sizes to buffer sizes when displaying help. "
:type 'boolean
:group 'electric-help )
2001-03-20 13:37:17 +00:00
( defcustom electric-help-mode-hook nil
" Hook run by `with-electric-help' after initializing the buffer. "
:type 'hook
:group 'electric-help )
1989-10-31 16:00:07 +00:00
( put 'electric-help-undefined 'suppress-keymap t )
( if electric-help-map
( )
( let ( ( map ( make-keymap ) ) )
1995-10-21 22:23:48 +00:00
;; allow all non-self-inserting keys - search, scroll, etc, but
;; let M-x and C-x exit ehelp mode and retain buffer:
1995-02-14 09:08:40 +00:00
( suppress-keymap map )
1995-10-21 22:23:48 +00:00
( define-key map " \C -u " 'electric-help-undefined )
( define-key map [ ?\C -0 ] 'electric-help-undefined )
( define-key map [ ?\C -1 ] 'electric-help-undefined )
( define-key map [ ?\C -2 ] 'electric-help-undefined )
( define-key map [ ?\C -3 ] 'electric-help-undefined )
( define-key map [ ?\C -4 ] 'electric-help-undefined )
( define-key map [ ?\C -5 ] 'electric-help-undefined )
( define-key map [ ?\C -6 ] 'electric-help-undefined )
( define-key map [ ?\C -7 ] 'electric-help-undefined )
( define-key map [ ?\C -8 ] 'electric-help-undefined )
( define-key map [ ?\C -9 ] 'electric-help-undefined )
1989-10-31 16:00:07 +00:00
( define-key map ( char-to-string help-char ) 'electric-help-help )
( define-key map " ? " 'electric-help-help )
( define-key map " " 'scroll-up )
( define-key map " \^ ? " 'scroll-down )
( define-key map " . " 'beginning-of-buffer )
( define-key map " < " 'beginning-of-buffer )
( define-key map " > " 'end-of-buffer )
;(define-key map "\C-g" 'electric-help-exit)
( define-key map " Q " 'electric-help-exit )
2004-11-01 23:16:25 +00:00
( define-key map " q " 'electric-help-exit )
1989-10-31 16:00:07 +00:00
;;a better key than this?
1995-02-14 09:08:40 +00:00
( define-key map " R " 'electric-help-retain )
2004-11-01 23:16:25 +00:00
( define-key map " r " 'electric-help-retain )
1995-10-21 22:23:48 +00:00
( define-key map " \e x " 'electric-help-execute-extended )
( define-key map " \C -x " 'electric-help-ctrl-x-prefix )
1989-10-31 16:00:07 +00:00
( setq electric-help-map map ) ) )
1995-10-21 22:23:48 +00:00
1989-10-31 16:00:07 +00:00
( defun electric-help-mode ( )
1991-02-28 21:40:18 +00:00
" `with-electric-help' temporarily places its buffer in this mode.
\(On exit from ` with-electric-help ', the buffer is put in ` default-major-mode '. ) "
1989-10-31 16:00:07 +00:00
( setq buffer-read-only t )
( setq mode-name " Help " )
( setq major-mode 'help )
( setq mode-line-buffer-identification ' ( " Help: %b " ) )
( use-local-map electric-help-map )
1996-04-05 16:05:03 +00:00
( add-hook 'mouse-leave-buffer-hook 'electric-help-retain )
1996-02-03 03:18:00 +00:00
( view-mode -1 )
1989-10-31 16:00:07 +00:00
;; this is done below in with-electric-help
;(run-hooks 'electric-help-mode-hook)
)
1995-07-18 23:31:41 +00:00
;;;###autoload
1995-11-02 20:30:38 +00:00
( defun with-electric-help ( thunk &optional buffer noerase minheight )
1995-07-30 07:04:58 +00:00
" Pop up an \" electric \" help buffer.
1995-10-21 22:23:48 +00:00
The arguments are THUNK &optional BUFFER NOERASE MINHEIGHT.
THUNK is a function of no arguments which is called to initialize the
contents of BUFFER. BUFFER defaults to ` *Help* '. BUFFER will be
erased before THUNK is called unless NOERASE is non-nil. THUNK will
be called while BUFFER is current and with ` standard-output ' bound to
1995-07-30 07:04:58 +00:00
the buffer specified by BUFFER.
If THUNK returns nil , we display BUFFER starting at the top, and
shrink the window to fit. If THUNK returns non-nil, we don 't do those things.
1989-10-31 16:00:07 +00:00
After THUNK has been called, this function \"electrically\" pops up a window
in which BUFFER is displayed and allows the user to scroll through that buffer
1995-10-21 22:23:48 +00:00
in electric-help-mode. The window 's height will be at least MINHEIGHT if
this value is non-nil.
If THUNK returns nil , we display BUFFER starting at the top, and
2000-09-20 20:39:36 +00:00
shrink the window to fit if ` electric-help-shrink-window ' is non-nil.
If THUNK returns non-nil, we don 't do those things.
1995-10-21 22:23:48 +00:00
2001-02-20 19:22:43 +00:00
When the user exits ( with ` electric-help-exit ', or otherwise ) , the help
buffer 's window disappears ( i.e., we use ` save-window-excursion ' ) , and
1995-07-18 23:31:41 +00:00
BUFFER is put into ` default-major-mode ' ( or ` fundamental-mode ' ) when we exit. "
1989-10-31 16:00:07 +00:00
( setq buffer ( get-buffer-create ( or buffer " *Help* " ) ) )
( let ( ( one ( one-window-p t ) )
1991-01-11 19:38:45 +00:00
( config ( current-window-configuration ) )
1995-10-21 22:23:48 +00:00
( bury nil )
1996-02-03 03:18:00 +00:00
( electric-help-form-to-execute nil ) )
1991-01-11 19:38:45 +00:00
( unwind-protect
( save-excursion
2000-09-20 20:39:36 +00:00
( when one
( goto-char ( window-start ( selected-window ) ) ) )
1991-01-11 19:38:45 +00:00
( let ( ( pop-up-windows t ) )
( pop-to-buffer buffer ) )
( save-excursion
( set-buffer buffer )
2000-09-20 20:39:36 +00:00
( when ( and minheight ( < ( window-height ) minheight ) )
( enlarge-window ( - minheight ( window-height ) ) ) )
1991-01-11 19:38:45 +00:00
( electric-help-mode )
1996-03-07 18:15:59 +00:00
( setq buffer-read-only nil )
2000-09-20 20:39:36 +00:00
( unless noerase
( erase-buffer ) ) )
1991-01-11 19:38:45 +00:00
( let ( ( standard-output buffer ) )
2000-09-20 20:39:36 +00:00
( unless ( funcall thunk )
( set-buffer buffer )
( set-buffer-modified-p nil )
( goto-char ( point-min ) )
( when ( and one electric-help-shrink-window )
( shrink-window-if-larger-than-buffer ) ) ) )
1991-01-11 19:38:45 +00:00
( set-buffer buffer )
( run-hooks 'electric-help-mode-hook )
1996-03-07 18:15:59 +00:00
( setq buffer-read-only t )
2000-09-20 20:39:36 +00:00
( if ( eq ( car-safe ( electric-help-command-loop ) ) 'retain )
1991-01-11 19:38:45 +00:00
( setq config ( current-window-configuration ) )
2000-09-20 20:39:36 +00:00
( setq bury t ) )
1997-03-28 22:58:58 +00:00
;; Remove the hook.
2000-09-20 20:39:36 +00:00
( when ( memq 'electric-help-retain mouse-leave-buffer-hook )
( remove-hook 'mouse-leave-buffer-hook 'electric-help-retain ) ) )
1991-01-11 19:38:45 +00:00
( message " " )
( set-buffer buffer )
( setq buffer-read-only nil )
2000-09-20 20:39:36 +00:00
;; We should really get a usable *Help* buffer when retaining
;; the electric one with `r'. The problem is that a simple
2001-02-20 19:22:43 +00:00
;; call to help-mode won't cut it; at least RET is bound wrong
2000-09-20 20:39:36 +00:00
;; afterwards. It's also not clear that `help-mode' is always
;; the right thing, maybe we should add an optional parameter.
1991-01-11 19:38:45 +00:00
( condition-case ( )
( funcall ( or default-major-mode 'fundamental-mode ) )
( error nil ) )
2003-02-04 11:26:42 +00:00
1991-01-11 19:38:45 +00:00
( set-window-configuration config )
2000-09-20 20:39:36 +00:00
( when bury
2001-02-20 19:22:43 +00:00
;;>> Perhaps this shouldn't be done,
2000-09-20 20:39:36 +00:00
;; so that when we say "Press space to bury" we mean it
( replace-buffer-in-windows buffer )
;; must do this outside of save-window-excursion
( bury-buffer buffer ) )
1996-02-03 03:18:00 +00:00
( eval electric-help-form-to-execute ) ) ) )
1989-10-31 16:00:07 +00:00
( defun electric-help-command-loop ( )
( catch 'exit
( if ( pos-visible-in-window-p ( point-max ) )
1996-01-25 00:53:48 +00:00
( progn ( message " %s " ( substitute-command-keys " <<< Press Space to bury the help buffer, Press \\ [electric-help-retain] to retain it >>> " ) )
1993-06-03 03:50:05 +00:00
( if ( equal ( setq unread-command-events ( list ( read-event ) ) )
2006-11-27 13:49:57 +00:00
' ( ?\s ) )
1993-01-26 01:58:16 +00:00
( progn ( setq unread-command-events nil )
1989-10-31 16:00:07 +00:00
( throw 'exit t ) ) ) ) )
( let ( up down both neither
2004-05-03 22:21:46 +00:00
( standard ( and ( eq ( key-binding " " nil t )
1989-10-31 16:00:07 +00:00
'scroll-up )
2004-05-03 22:21:46 +00:00
( eq ( key-binding " \^ ? " nil t )
1989-10-31 16:00:07 +00:00
'scroll-down )
2004-05-03 22:21:46 +00:00
( eq ( key-binding " q " nil t )
1995-02-14 09:08:40 +00:00
'electric-help-exit )
2004-05-03 22:21:46 +00:00
( eq ( key-binding " r " nil t )
1995-02-14 09:08:40 +00:00
'electric-help-retain ) ) ) )
1989-10-31 16:00:07 +00:00
( Electric-command-loop
'exit
( function ( lambda ( )
2003-02-04 11:26:42 +00:00
( sit-for 0 ) ;necessary if last command was end-of-buffer or
;beginning-of-buffer - otherwise pos-visible-in-window-p
1995-10-21 22:23:48 +00:00
;will yield a wrong result.
1989-10-31 16:00:07 +00:00
( let ( ( min ( pos-visible-in-window-p ( point-min ) ) )
2004-05-06 00:43:33 +00:00
( max ( pos-visible-in-window-p ( 1- ( point-max ) ) ) ) )
1995-10-21 22:23:48 +00:00
( cond ( isearch-mode 'noprompt )
( ( and min max )
1995-02-14 09:08:40 +00:00
( cond ( standard " Press q to exit, r to retain " )
1989-10-31 16:00:07 +00:00
( neither )
1995-02-14 09:08:40 +00:00
( t ( setq neither ( substitute-command-keys " Press \\ [electric-help-exit] to exit, \\ [electric-help-retain] to retain " ) ) ) ) )
1989-10-31 16:00:07 +00:00
( min
1995-02-14 09:08:40 +00:00
( cond ( standard " Press SPC to scroll, q to exit, r to retain " )
1989-10-31 16:00:07 +00:00
( up )
1995-02-14 09:08:40 +00:00
( t ( setq up ( substitute-command-keys " Press \\ [scroll-up] to scroll, \\ [electric-help-exit] to exit, \\ [electric-help-retain] to retain " ) ) ) ) )
1989-10-31 16:00:07 +00:00
( max
1995-10-21 22:23:48 +00:00
( cond ( standard " Press DEL to scroll back, q to exit, r to retain " )
1989-10-31 16:00:07 +00:00
( down )
1995-02-14 09:08:40 +00:00
( t ( setq down ( substitute-command-keys " Press \\ [scroll-down] to scroll back, \\ [electric-help-exit] to exit, \\ [electric-help-retain] to retain " ) ) ) ) )
1989-10-31 16:00:07 +00:00
( t
1995-10-21 22:23:48 +00:00
( cond ( standard " Press SPC to scroll, DEL to scroll back, q to exit, r to retain " )
1989-10-31 16:00:07 +00:00
( both )
1995-02-14 09:08:40 +00:00
( t ( setq both ( substitute-command-keys " Press \\ [scroll-up] to scroll, \\ [scroll-down] to scroll back, \\ [electric-help-exit] to exit, \\ [electric-help-retain] to retain " ) ) ) ) ) ) ) ) )
1989-10-31 16:00:07 +00:00
t ) ) ) )
;(defun electric-help-scroll-up (arg)
; ">>>Doc"
; (interactive "P")
; (if (and (null arg) (pos-visible-in-window-p (point-max)))
; (electric-help-exit)
; (scroll-up arg)))
( defun electric-help-exit ( )
1997-03-28 22:58:58 +00:00
" Exit `electric-help' , restoring the previous window/buffer configuration.
\(The *Help* buffer will be buried. ) "
1989-10-31 16:00:07 +00:00
( interactive )
1997-03-28 22:58:58 +00:00
;; Make sure that we don't throw twice, even if two events cause
;; calling this function:
( if ( memq 'electric-help-retain mouse-leave-buffer-hook )
( progn
( remove-hook 'mouse-leave-buffer-hook 'electric-help-retain )
( throw 'exit t ) ) ) )
1989-10-31 16:00:07 +00:00
( defun electric-help-retain ( )
1991-02-28 21:40:18 +00:00
" Exit `electric-help' , retaining the current window/buffer configuration.
1989-10-31 16:00:07 +00:00
\(The *Help* buffer will not be selected, but \\ [ switch-to-buffer-other-window ] RET
will select it. ) "
( interactive )
1995-10-21 22:23:48 +00:00
;; Make sure that we don't throw twice, even if two events cause
;; calling this function:
1996-04-05 16:05:03 +00:00
( if ( memq 'electric-help-retain mouse-leave-buffer-hook )
( progn
( remove-hook 'mouse-leave-buffer-hook 'electric-help-retain )
( throw 'exit ' ( retain ) ) ) ) )
1989-10-31 16:00:07 +00:00
( defun electric-help-undefined ( )
( interactive )
( error " %s is undefined -- Press %s to exit "
( mapconcat 'single-key-description ( this-command-keys ) " " )
2004-05-03 22:21:46 +00:00
( if ( eq ( key-binding " q " nil t ) 'electric-help-exit )
1995-10-21 22:23:48 +00:00
" q "
1989-10-31 16:00:07 +00:00
( substitute-command-keys " \\ [electric-help-exit] " ) ) ) )
;>>> this needs to be hairified (recursive help, anybody?)
( defun electric-help-help ( )
( interactive )
2004-05-03 22:21:46 +00:00
( if ( and ( eq ( key-binding " q " nil t ) 'electric-help-exit )
( eq ( key-binding " " nil t ) 'scroll-up )
( eq ( key-binding " \^ ? " nil t ) 'scroll-down )
( eq ( key-binding " r " nil t ) 'electric-help-retain ) )
1995-02-14 09:08:40 +00:00
( message " SPC scrolls up, DEL scrolls down, q exits burying help buffer, r exits " )
( message " %s " ( substitute-command-keys " \\ [scroll-up] scrolls up, \\ [scroll-down] scrolls down, \\ [electric-help-exit] exits burying help buffer, \\ [electric-help-retain] exits " ) ) )
1989-10-31 16:00:07 +00:00
( sit-for 2 ) )
1995-07-18 23:31:41 +00:00
;;;###autoload
1996-05-31 15:33:29 +00:00
( defun electric-helpify ( fun &optional name )
( let ( ( name ( or name " *Help* " ) ) )
1989-10-31 16:00:07 +00:00
( if ( save-window-excursion
;; kludge-o-rama
( let* ( ( p ( symbol-function 'print-help-return-message ) )
( b ( get-buffer name ) )
( m ( buffer-modified-p b ) ) )
( and b ( not ( get-buffer-window b ) )
( setq b nil ) )
( unwind-protect
( progn
( message " %s... " ( capitalize ( symbol-name fun ) ) )
;; with-output-to-temp-buffer marks the buffer as unmodified.
;; kludging excessively and relying on that as some sort
;; of indication leads to the following abomination...
;;>> This would be doable without such icky kludges if either
;;>> (a) there were a function to read the interactive
;;>> args for a command and return a list of those args.
;;>> (To which one would then just apply the command)
;;>> (The only problem with this is that interactive-p
;;>> would break, but that is such a misfeature in
;;>> any case that I don't care)
;;>> It is easy to do this for emacs-lisp functions;
;;>> the only problem is getting the interactive spec
;;>> for subrs
;;>> (b) there were a function which returned a
;;>> modification-tick for a buffer. One could tell
;;>> whether a buffer had changed by whether the
;;>> modification-tick were different.
;;>> (Presumably there would have to be a way to either
;;>> restore the tick to some previous value, or to
;;>> suspend updating of the tick in order to allow
;;>> things like momentary-string-display)
( and b
( save-excursion
( set-buffer b )
( set-buffer-modified-p t ) ) )
( fset 'print-help-return-message 'ignore )
( call-interactively fun )
( and ( get-buffer name )
( get-buffer-window ( get-buffer name ) )
( or ( not b )
( not ( eq b ( get-buffer name ) ) )
( not ( buffer-modified-p b ) ) ) ) )
( fset 'print-help-return-message p )
( and b ( buffer-name b )
( save-excursion
( set-buffer b )
( set-buffer-modified-p m ) ) ) ) ) )
( with-electric-help 'ignore name t ) ) ) )
1995-10-21 22:23:48 +00:00
2003-02-04 11:26:42 +00:00
;; This is to be bound to M-x in ehelp mode. Retains ehelp buffer and then
1995-10-21 22:23:48 +00:00
;; continues with execute-extended-command.
( defun electric-help-execute-extended ( prefixarg )
( interactive " p " )
1996-02-03 03:18:00 +00:00
( setq electric-help-form-to-execute ' ( execute-extended-command nil ) )
1995-10-21 22:23:48 +00:00
( electric-help-retain ) )
;; This is to be buond to C-x in ehelp mode. Retains ehelp buffer and then
;; continues with ctrl-x prefix.
( defun electric-help-ctrl-x-prefix ( prefixarg )
( interactive " p " )
1996-02-03 03:18:00 +00:00
( setq electric-help-form-to-execute ' ( progn ( message nil ) ( setq unread-command-char ?\C -x ) ) )
1995-10-21 22:23:48 +00:00
( electric-help-retain ) )
1989-10-31 16:00:07 +00:00
( defun electric-describe-key ( )
( interactive )
( electric-helpify 'describe-key ) )
( defun electric-describe-mode ( )
( interactive )
( electric-helpify 'describe-mode ) )
( defun electric-view-lossage ( )
( interactive )
( electric-helpify 'view-lossage ) )
;(defun electric-help-for-help ()
; "See help-for-help"
; (interactive)
; )
( defun electric-describe-function ( )
( interactive )
( electric-helpify 'describe-function ) )
( defun electric-describe-variable ( )
( interactive )
( electric-helpify 'describe-variable ) )
( defun electric-describe-bindings ( )
( interactive )
( electric-helpify 'describe-bindings ) )
( defun electric-describe-syntax ( )
( interactive )
( electric-helpify 'describe-syntax ) )
( defun electric-command-apropos ( )
( interactive )
1996-05-31 15:33:29 +00:00
( electric-helpify 'command-apropos " *Apropos* " ) )
1989-10-31 16:00:07 +00:00
;(define-key help-map "a" 'electric-command-apropos)
1995-02-14 09:08:40 +00:00
( defun electric-apropos ( )
( interactive )
( electric-helpify 'apropos ) )
1989-10-31 16:00:07 +00:00
;;;; ehelp-map
( defvar ehelp-map ( ) )
( if ehelp-map
nil
2003-02-04 11:26:42 +00:00
( let ( ( map ( copy-keymap help-map ) ) )
1995-10-21 22:23:48 +00:00
( substitute-key-definition 'apropos 'electric-apropos map )
1995-02-14 09:08:40 +00:00
( substitute-key-definition 'command-apropos 'electric-command-apropos map )
1989-10-31 16:00:07 +00:00
( substitute-key-definition 'describe-key 'electric-describe-key map )
( substitute-key-definition 'describe-mode 'electric-describe-mode map )
( substitute-key-definition 'view-lossage 'electric-view-lossage map )
( substitute-key-definition 'describe-function 'electric-describe-function map )
( substitute-key-definition 'describe-variable 'electric-describe-variable map )
( substitute-key-definition 'describe-bindings 'electric-describe-bindings map )
( substitute-key-definition 'describe-syntax 'electric-describe-syntax map )
2003-07-07 21:05:17 +00:00
( setq ehelp-map map ) ) )
;;;###(autoload 'ehelp-command "ehelp" "Prefix command for ehelp." t 'keymap)
( defalias 'ehelp-command ehelp-map )
( put 'ehelp-command 'documentation " Prefix command for ehelp. " )
1989-10-31 16:00:07 +00:00
2003-02-04 11:26:42 +00:00
( provide 'ehelp )
1992-03-16 20:39:07 +00:00
2003-09-01 15:45:59 +00:00
;;; arch-tag: e0e3037f-42c0-433e-ba18-322c5d951f46
1992-05-30 23:54:21 +00:00
;;; ehelp.el ends here