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

comparison lisp/electric/ehelp.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30

author	cvs
date	Mon, 13 Aug 2007 09:02:59 +0200
parents	b82b59fe008d
children	b9518feda344

comparison

equal deleted inserted replaced

-:804d1389bcd6
+:131b0175ea99
 ;;; 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, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-;; 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)
-(add-hook 'mouse-leave-buffer-hook 'electric-help-retain)
+(setq 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)
-(electric-help-form-to-execute nil))
+(to-be-executed 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
+	    (or noerase (erase-buffer)))
-		(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
-		   ;; XEmacs: Don't be screwed by minor-modes (view-minor-mode)
+		   ;; 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 "")
+(message nil)
 (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 electric-help-form-to-execute))))
+(eval to-be-executed))))
 (defun electric-help-command-loop ()
 (catch 'exit
 (if (pos-visible-in-window-p (point-max))
-	(progn (message "%s" (substitute-command-keys "<<< Press Space to bury the help buffer, Press \\[electric-help-retain] to retain it >>>"))
+	(progn (message (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 (memq 'electric-help-retain mouse-leave-buffer-hook)
+(if mouse-leave-buffer-hook
 (progn
-	(remove-hook 'mouse-leave-buffer-hook 'electric-help-retain)
+(setq mouse-leave-buffer-hook nil)
-	(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 name)
+(defun electric-helpify (fun &optional buffer-name)
-(let ((name (or name "*Help*")))
+(or buffer-name (setq buffer-name "*Help*"))
-(if (save-window-excursion
+(let* ((p (symbol-function 'print-help-return-message))
-	  ;; kludge-o-rama
+(b (get-buffer buffer-name))
-	  (let* ((p (symbol-function 'print-help-return-message))
+(tick (and b (buffer-modified-tick b))))
-		 (b (get-buffer name))
+(and b (not (get-buffer-window b))
-		 (m (buffer-modified-p b)))
+(setq b nil))
-	    (and b (not (get-buffer-window b))
+(if (unwind-protect
-		 (setq b nil))
+(save-window-excursion
-	    (unwind-protect
+(message "%s..." (capitalize (symbol-name fun)))
-		(progn
+;; kludge-o-rama
-		  (message "%s..." (capitalize (symbol-name fun)))
+(fset 'print-help-return-message 'ignore)
-		  ;; with-output-to-temp-buffer marks the buffer as unmodified.
+(let ((a (call-interactively fun 'lambda)))
-		  ;; kludging excessively and relying on that as some sort
+(let ((temp-buffer-show-function 'ignore))
-		  ;;  of indication leads to the following abomination...
+(apply fun a)))
-		  ;;>> This would be doable without such icky kludges if either
+(message nil)
-		  ;;>> (a) there were a function to read the interactive
+;; Was a non-empty help buffer created/modified?
-		  ;;>>     args for a command and return a list of those args.
+(let ((r (get-buffer buffer-name)))
-		  ;;>>     (To which one would then just apply the command)
+(and r
-		  ;;>>     (The only problem with this is that interactive-p
+;(get-buffer-window r)
-		  ;;>>      would break, but that is such a misfeature in
+(or (not b)
-		  ;;>>      any case that I don't care)
+(not (eq b r))
-		  ;;>>     It is easy to do this for emacs-lisp functions;
+(not (eql tick (buffer-modified-tick b))))
-		  ;;>>     the only problem is getting the interactive spec
+(save-excursion
-		  ;;>>     for subrs
+(set-buffer r)
-		  ;;>> (b) there were a function which returned a
+(> (buffer-size) 0)))))
-		  ;;>>     modification-tick for a buffer.  One could tell
+	  (fset 'print-help-return-message p)
-		  ;;>>     whether a buffer had changed by whether the
+	  )
-		  ;;>>     modification-tick were different.
+(with-electric-help 'ignore buffer-name t))))
-		  ;;>>     (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 electric-help-form-to-execute '(execute-extended-command nil))
+(setq to-be-executed '(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 electric-help-form-to-execute '(progn (message nil) (setq unread-command-char ?\C-x)))
+(setq to-be-executed '(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 "*Apropos*"))
+(electric-helpify 'command-apropos))
 ;(define-key help-map "a" 'electric-command-apropos)
 (defun electric-apropos ()
 (interactive)
 (electric-helpify 'apropos))
 ;;;; ehelp-map
-(defvar ehelp-map ())
+(defvar ehelp-map nil)
 (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 @ 70:131b0175ea99 r20-0b30