xemacs-beta: lisp/electric/ehelp.el comparison

comparison lisp/electric/ehelp.el @ 4:b82b59fe008d r19-15b3

Import from CVS: tag r19-15b3

author	cvs
date	Mon, 13 Aug 2007 08:46:56 +0200
parents	376386a54a3c
children	131b0175ea99

comparison

equal deleted inserted replaced

-:30df88044ec6
+:b82b59fe008d
 ;;; ehelp.el --- bindings for electric-help mode
 ;; Copyright (C) 1986, 1995 Free Software Foundation, Inc.
 ;; Author: Richard Mlynarik <mly@ai.mit.edu>
 ;; Maintainer: FSF
 ;; Keywords: help, extensions
 ;; This file is part of XEmacs.
 ;; 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
 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
-;;; Synched up with: FSF 19.30.
+;;; Synched up with: FSF 19.34.
 ;;; Commentary:
 ;; This package provides a pre-packaged `Electric Help Mode' for
 ;; browsing on-line help screens.  There is one entry point,
 ;; (define-key global-map [f1] 'ehelp-command)
 ;;; Code:
 (require 'electric)
+(defvar electric-help-map ()
-(defvar electric-help-map nil
 "Keymap defining commands available in `electric-help-mode'.")
+(defvar electric-help-form-to-execute nil)
 (put 'electric-help-undefined 'suppress-keymap t)
 (if electric-help-map
 ()
 (let ((map (make-keymap)))
-(set-keymap-name map 'electric-help-map)
 ;; allow all non-self-inserting keys - search, scroll, etc, but
 ;; let M-x and C-x exit ehelp mode and retain buffer:
 (suppress-keymap map)
 (define-key map "\C-u" 'electric-help-undefined)
 (define-key map [(control ?0)] 'electric-help-undefined)
 (define-key map [(control ?7)] 'electric-help-undefined)
 (define-key map [(control ?8)] 'electric-help-undefined)
 (define-key map [(control ?9)] 'electric-help-undefined)
 (define-key map (char-to-string help-char) 'electric-help-help)
 (define-key map "?" 'electric-help-help)
+;; XEmacs addition
 (define-key map 'help '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)
 (setq electric-help-map map)))
 (defun electric-help-mode ()
 "`with-electric-help' temporarily places its buffer in this mode.
-\(On exit from `with-electric-help', the buffer is put in `default-major-mode'.\)"
+\(On exit from `with-electric-help', the buffer is put in `default-major-mode'.)"
 (setq buffer-read-only t)
 (setq mode-name "Help")
 (setq major-mode 'help)
 (setq modeline-buffer-identification '(" Help:  %b"))
 (use-local-map electric-help-map)
-(setq mouse-leave-buffer-hook '(electric-help-retain))
+(add-hook 'mouse-leave-buffer-hook 'electric-help-retain)
+(view-mode -1)
 ;; this is done below in with-electric-help
 ;(run-hooks 'electric-help-mode-hook)
 )
 ;;;###autoload
 BUFFER is put into `default-major-mode' (or `fundamental-mode') when we exit."
 (setq buffer (get-buffer-create (or buffer "*Help*")))
 (let ((one (one-window-p t))
 	(config (current-window-configuration))
 (bury nil)
-(to-be-executed nil))
+(electric-help-form-to-execute nil))
 (unwind-protect
 	(save-excursion
 	  (if one (goto-char (window-start (selected-window))))
 	  (let ((pop-up-windows t))
 	    (pop-to-buffer buffer))
 	    (set-buffer buffer)
 	    (if (and minheight (< (window-height) minheight))
 		(enlarge-window (- minheight (window-height))))
 	    (electric-help-mode)
 	    (setq buffer-read-only nil)
-	    (or noerase (erase-buffer)))
+	    (or noerase
+		(erase-buffer)))
 	  (let ((standard-output buffer))
 	    (if (not (funcall thunk))
 		(progn
 		  (set-buffer buffer)
 		  (set-buffer-modified-p nil)
 		  (goto-char (point-min))
 		  (if one (shrink-window-if-larger-than-buffer (selected-window))))))
 	  (set-buffer buffer)
 	  (run-hooks 'electric-help-mode-hook)
+	  (setq buffer-read-only t)
 	  (if (eq (car-safe
-		   ;; Don't be screwed by minor-modes (view-minor-mode)
+		   ;; XEmacs: Don't be screwed by minor-modes (view-minor-mode)
 		   (let ((overriding-local-map electric-help-map))
 		     (electric-help-command-loop)))
 		  'retain)
 	      (setq config (current-window-configuration))
 	    (setq bury t)))
-(message nil)
+(message "")
 (set-buffer buffer)
 (setq buffer-read-only nil)
 (condition-case ()
 	  (funcall (or default-major-mode 'fundamental-mode))
 	(error nil))
 ;;>> Perhaps this shouldn't be done.
 ;; 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)))
-(eval to-be-executed))))
+(eval electric-help-form-to-execute))))
 (defun electric-help-command-loop ()
 (catch 'exit
 (if (pos-visible-in-window-p (point-max))
-	(progn (message (substitute-command-keys "<<< Press Space to bury the help buffer, Press \\[electric-help-retain] to retain it >>>"))
+	(progn (message "%s" (substitute-command-keys "<<< Press Space to bury the help buffer, Press \\[electric-help-retain] to retain it >>>"))
+	       ;; XEmacs change
 	       (if (equal (setq unread-command-events
 				(list (next-command-event)))
 			  '(?\ ))
 		   (progn (setq unread-command-events nil)
 			  (throw 'exit t)))))
 		    t))))
 ;(defun electric-help-scroll-up (arg)
-;  "####Doc"
+;  ">>>Doc"
 ;  (interactive "P")
 ;  (if (and (null arg) (pos-visible-in-window-p (point-max)))
 ;      (electric-help-exit)
 ;    (scroll-up arg)))
 (defun electric-help-exit ()
-"####Doc"
+">>>Doc"
 (interactive)
 (throw 'exit t))
 (defun electric-help-retain ()
 "Exit `electric-help', retaining the current window/buffer configuration.
 \(The *Help* buffer will not be selected, but \\[switch-to-buffer-other-window] RET
 will select it.)"
 (interactive)
 ;; Make sure that we don't throw twice, even if two events cause
 ;; calling this function:
-(if mouse-leave-buffer-hook
+(if (memq 'electric-help-retain mouse-leave-buffer-hook)
 (progn
-(setq mouse-leave-buffer-hook nil)
+	(remove-hook 'mouse-leave-buffer-hook 'electric-help-retain)
-(throw 'exit '(retain)))))
+	(throw 'exit '(retain)))))
-;(defun electric-help-undefined ()
-;  (interactive)
-;  (let* ((keys (this-command-keys))
-;	 (n (length keys)))
-;    (if (or (= n 1)
-;	    (and (= n 2)
-;		 meta-flag
-;		 (eq (aref keys 0) meta-prefix-char)))
-;	(setq unread-command-char last-input-char
-;	      current-prefix-arg prefix-arg)
-;      ;;#### I don't care.
-;      ;;#### The emacs command-loop is too much pure pain to
-;      ;;#### duplicate
-;      ))
-;  (throw 'exit t))
 (defun electric-help-undefined ()
 (interactive)
 (error "%s is undefined -- Press %s to exit"
 	 (mapconcat 'single-key-description (this-command-keys) " ")
 	 (if (eq (key-binding "q") 'electric-help-exit)
 	     "q"
 	   (substitute-command-keys "\\[electric-help-exit]"))))
-;#### this needs to be hairified (recursive help, anybody?)
+;>>> this needs to be hairified (recursive help, anybody?)
 (defun electric-help-help ()
 (interactive)
 (if (and (eq (key-binding "q") 'electric-help-exit)
 	   (eq (key-binding " ") 'scroll-up)
 	   (eq (key-binding "\^?") 'scroll-down)
 (message "%s" (substitute-command-keys "\\[scroll-up] scrolls up, \\[scroll-down] scrolls down, \\[electric-help-exit] exits burying help buffer, \\[electric-help-retain] exits")))
 (sit-for 2))
 ;;;###autoload
-(defun electric-helpify (fun &optional buffer-name)
+(defun electric-helpify (fun &optional name)
-(or buffer-name (setq buffer-name "*Help*"))
+(let ((name (or name "*Help*")))
-(let* ((p (symbol-function 'print-help-return-message))
+(if (save-window-excursion
-(b (get-buffer buffer-name))
+	  ;; kludge-o-rama
-(tick (and b (buffer-modified-tick b))))
+	  (let* ((p (symbol-function 'print-help-return-message))
-(and b (not (get-buffer-window b))
+		 (b (get-buffer name))
-(setq b nil))
+		 (m (buffer-modified-p b)))
-(if (unwind-protect
+	    (and b (not (get-buffer-window b))
-(save-window-excursion
+		 (setq b nil))
-(message "%s..." (capitalize (symbol-name fun)))
+	    (unwind-protect
-;; kludge-o-rama
+		(progn
-(fset 'print-help-return-message 'ignore)
+		  (message "%s..." (capitalize (symbol-name fun)))
-(let ((a (call-interactively fun 'lambda)))
+		  ;; with-output-to-temp-buffer marks the buffer as unmodified.
-(let ((temp-buffer-show-function 'ignore))
+		  ;; kludging excessively and relying on that as some sort
-(apply fun a)))
+		  ;;  of indication leads to the following abomination...
-(message nil)
+		  ;;>> This would be doable without such icky kludges if either
-;; Was a non-empty help buffer created/modified?
+		  ;;>> (a) there were a function to read the interactive
-(let ((r (get-buffer buffer-name)))
+		  ;;>>     args for a command and return a list of those args.
-(and r
+		  ;;>>     (To which one would then just apply the command)
-;(get-buffer-window r)
+		  ;;>>     (The only problem with this is that interactive-p
-(or (not b)
+		  ;;>>      would break, but that is such a misfeature in
-(not (eq b r))
+		  ;;>>      any case that I don't care)
-(not (eql tick (buffer-modified-tick b))))
+		  ;;>>     It is easy to do this for emacs-lisp functions;
-(save-excursion
+		  ;;>>     the only problem is getting the interactive spec
-(set-buffer r)
+		  ;;>>     for subrs
-(> (buffer-size) 0)))))
+		  ;;>> (b) there were a function which returned a
-	  (fset 'print-help-return-message p)
+		  ;;>>     modification-tick for a buffer.  One could tell
-	  )
+		  ;;>>     whether a buffer had changed by whether the
-(with-electric-help 'ignore buffer-name t))))
+		  ;;>>     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))))
 ;; This is to be bound to M-x in ehelp mode. Retains ehelp buffer and then
 ;; continues with execute-extended-command.
 (defun electric-help-execute-extended (prefixarg)
 (interactive "p")
-(setq to-be-executed '(execute-extended-command nil))
+(setq electric-help-form-to-execute '(execute-extended-command nil))
 (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")
-(setq to-be-executed '(progn (message nil) (setq unread-command-char ?\C-x)))
+(setq electric-help-form-to-execute '(progn (message nil) (setq unread-command-char ?\C-x)))
 (electric-help-retain))
 (defun electric-describe-key ()
 (interactive)
 (interactive)
 (electric-helpify 'describe-syntax))
 (defun electric-command-apropos ()
 (interactive)
-(electric-helpify 'command-apropos))
+(electric-helpify 'command-apropos "*Apropos*"))
 ;(define-key help-map "a" 'electric-command-apropos)
 (defun electric-apropos ()
 (interactive)
 (electric-helpify 'apropos))
 ;;;; ehelp-map
-(defvar ehelp-map nil)
+(defvar ehelp-map ())
 (if ehelp-map
 nil
 ;; #### WTF?  Why don't we just use substitute-key-definition
 ;; like FSF does?
 (let ((shadow '((apropos . electric-apropos)

Mercurial > hg > xemacs-beta

comparison lisp/electric/ehelp.el @ 4:b82b59fe008d r19-15b3