Mercurial > hg > xemacs-beta
diff 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 |
line wrap: on
line diff
--- a/lisp/electric/ehelp.el Mon Aug 13 09:00:04 2007 +0200 +++ b/lisp/electric/ehelp.el Mon Aug 13 09:02:59 2007 +0200 @@ -3,6 +3,7 @@ ;; Copyright (C) 1986, 1995 Free Software Foundation, Inc. ;; Author: Richard Mlynarik <mly@ai.mit.edu> + ;; Maintainer: FSF ;; Keywords: help, extensions @@ -20,10 +21,9 @@ ;; 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 -;; 02111-1307, USA. +;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -;;; Synched up with: FSF 19.34. +;;; Synched up with: FSF 19.30. ;;; Commentary: @@ -42,15 +42,15 @@ ;;; 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) @@ -67,7 +67,6 @@ (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) @@ -87,14 +86,13 @@ (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) - (view-mode -1) + (setq mouse-leave-buffer-hook '(electric-help-retain)) ;; this is done below in with-electric-help ;(run-hooks 'electric-help-mode-hook) ) @@ -128,7 +126,7 @@ (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)))) @@ -140,8 +138,7 @@ (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 @@ -151,15 +148,14 @@ (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 () @@ -173,13 +169,12 @@ (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 >>>")) - ;; XEmacs change + (progn (message (substitute-command-keys "<<< Press Space to bury the help buffer, Press \\[electric-help-retain] to retain it >>>")) (if (equal (setq unread-command-events (list (next-command-event))) '(?\ )) @@ -224,14 +219,14 @@ ;(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)) @@ -242,11 +237,27 @@ (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) - (progn - (remove-hook 'mouse-leave-buffer-hook 'electric-help-retain) - (throw 'exit '(retain))))) + (if mouse-leave-buffer-hook + (progn + (setq mouse-leave-buffer-hook nil) + (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) @@ -257,7 +268,7 @@ (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) @@ -270,56 +281,35 @@ ;;;###autoload -(defun electric-helpify (fun &optional name) - (let ((name (or name "*Help*"))) - (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)))) +(defun electric-helpify (fun &optional buffer-name) + (or buffer-name (setq buffer-name "*Help*")) + (let* ((p (symbol-function 'print-help-return-message)) + (b (get-buffer buffer-name)) + (tick (and b (buffer-modified-tick b)))) + (and b (not (get-buffer-window b)) + (setq b nil)) + (if (unwind-protect + (save-window-excursion + (message "%s..." (capitalize (symbol-name fun))) + ;; kludge-o-rama + (fset 'print-help-return-message 'ignore) + (let ((a (call-interactively fun 'lambda))) + (let ((temp-buffer-show-function 'ignore)) + (apply fun a))) + (message nil) + ;; Was a non-empty help buffer created/modified? + (let ((r (get-buffer buffer-name))) + (and r + ;(get-buffer-window r) + (or (not b) + (not (eq b r)) + (not (eql tick (buffer-modified-tick b)))) + (save-excursion + (set-buffer r) + (> (buffer-size) 0))))) + (fset 'print-help-return-message p) + ) + (with-electric-help 'ignore buffer-name t)))) @@ -327,14 +317,14 @@ ;; 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)) @@ -373,7 +363,7 @@ (defun electric-command-apropos () (interactive) - (electric-helpify 'command-apropos "*Apropos*")) + (electric-helpify 'command-apropos)) ;(define-key help-map "a" 'electric-command-apropos) @@ -381,10 +371,11 @@ (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