* Re: q doesn't always quit *Help*
2007-09-26 18:54 Drew Adams
@ 2007-09-27 9:05 ` martin rudalics
0 siblings, 0 replies; 9+ messages in thread
From: martin rudalics @ 2007-09-27 9:05 UTC (permalink / raw)
To: Drew Adams; +Cc: Bug-Gnu-Emacs
[-- Attachment #1: Type: text/plain, Size: 604 bytes --]
> There are plenty of contexts where `q' in *Help* does not quit. I and
> others have reported some in the past. Here is another:
>
> emacs -Q
>
> C-h f forward-char
>
> C-x 0 ; so *Help* is the only window
>
> q ; Does nothing.
>
>
> In general, View-mode quitting is a complex mess.
I'm working on this. You could help me by checking the attached patch.
It's against Emacs 22.1 and incorporates a couple of changes (help-xref,
find-source-lisp-file, and changes to faces.el) by other people.
There's also a new customizable variable called `help-window-select' ...
Suggestions welcome!
[-- Attachment #2: help-view.patch --]
[-- Type: text/plain, Size: 57823 bytes --]
*** descr-text.el Wed Jul 25 06:47:32 2007
--- descr-text.el Thu Sep 27 08:44:20 2007
***************
*** 588,594 ****
(if (cadr x) (length (car x)) 0))
item-list)))
(help-setup-xref nil (interactive-p))
! (with-output-to-temp-buffer (help-buffer)
(with-current-buffer standard-output
(set-buffer-multibyte multibyte-p)
(let ((formatter (format "%%%ds:" max-width)))
--- 588,594 ----
(if (cadr x) (length (car x)) 0))
item-list)))
(help-setup-xref nil (interactive-p))
! (with-help-window (help-buffer)
(with-current-buffer standard-output
(set-buffer-multibyte multibyte-p)
(let ((formatter (format "%%%ds:" max-width)))
***************
*** 685,692 ****
(if text-props-desc (insert text-props-desc))
(setq help-xref-stack-item (list 'help-insert-string (buffer-string)))
! (toggle-read-only 1)
! (print-help-return-message)))))
(defalias 'describe-char-after 'describe-char)
(make-obsolete 'describe-char-after 'describe-char "22.1")
--- 685,691 ----
(if text-props-desc (insert text-props-desc))
(setq help-xref-stack-item (list 'help-insert-string (buffer-string)))
! (toggle-read-only 1)))))
(defalias 'describe-char-after 'describe-char)
(make-obsolete 'describe-char-after 'describe-char "22.1")
*** disp-table.el Wed Jul 25 06:47:30 2007
--- disp-table.el Thu Sep 27 08:45:10 2007
***************
*** 75,81 ****
;;;###autoload
(defun describe-display-table (dt)
"Describe the display table DT in a help buffer."
! (with-output-to-temp-buffer "*Help*"
(princ "\nTruncation glyph: ")
(prin1 (display-table-slot dt 'truncation))
(princ "\nWrap glyph: ")
--- 75,81 ----
;;;###autoload
(defun describe-display-table (dt)
"Describe the display table DT in a help buffer."
! (with-help-window "*Help*"
(princ "\nTruncation glyph: ")
(prin1 (display-table-slot dt 'truncation))
(princ "\nWrap glyph: ")
***************
*** 97,104 ****
(aset vector i (aref dt i))
(setq i (1+ i)))
(describe-vector vector))
! (help-mode))
! (print-help-return-message)))
;;;###autoload
(defun describe-current-display-table ()
--- 97,103 ----
(aset vector i (aref dt i))
(setq i (1+ i)))
(describe-vector vector))
! (help-mode))))
;;;###autoload
(defun describe-current-display-table ()
***************
*** 220,226 ****
variable, or else customize `enable-multibyte-characters'.
With prefix argument, this command enables European character display
! if arg is positive, disables it otherwise. Otherwise, it toggles
European character display.
When this mode is enabled, characters in the range of 160 to 255
--- 219,225 ----
variable, or else customize `enable-multibyte-characters'.
With prefix argument, this command enables European character display
! if ARG is positive, disables it otherwise. Otherwise, it toggles
European character display.
When this mode is enabled, characters in the range of 160 to 255
***************
*** 264,268 ****
(provide 'disp-table)
! ;;; arch-tag: ffe4c28c-960c-47aa-b8a8-ae89d371ffc7
;;; disp-table.el ends here
--- 263,267 ----
(provide 'disp-table)
! ;; arch-tag: ffe4c28c-960c-47aa-b8a8-ae89d371ffc7
;;; disp-table.el ends here
*** faces.el Fri Aug 3 19:52:22 2007
--- faces.el Thu Sep 27 08:46:56 2007
***************
*** 222,232 ****
(defun face-id (face &optional frame)
"Return the internal ID of face with name FACE.
The optional argument FRAME is ignored, since the internal face ID
of a face name is the same for all frames."
(check-face face)
! (get face 'face))
!
(defun face-equal (face1 face2 &optional frame)
"Non-nil if faces FACE1 and FACE2 are equal.
--- 222,233 ----
(defun face-id (face &optional frame)
"Return the internal ID of face with name FACE.
+ If FACE is a face-alias, return the ID of the target face.
The optional argument FRAME is ignored, since the internal face ID
of a face name is the same for all frames."
(check-face face)
! (or (get face 'face)
! (face-id (get face 'face-alias))))
(defun face-equal (face1 face2 &optional frame)
"Non-nil if faces FACE1 and FACE2 are equal.
***************
*** 1193,1199 ****
(error "No faces matching \"%s\"" regexp))
(setq max-length (1+ max-length)
line-format (format "%%-%ds" max-length))
! (with-output-to-temp-buffer "*Faces*"
(save-excursion
(set-buffer standard-output)
(setq truncate-lines t)
--- 1194,1200 ----
(error "No faces matching \"%s\"" regexp))
(setq max-length (1+ max-length)
line-format (format "%%-%ds" max-length))
! (with-help-window "*Faces*"
(save-excursion
(set-buffer standard-output)
(setq truncate-lines t)
***************
*** 1234,1241 ****
(while (not (eobp))
(insert-char ?\s max-length)
(forward-line 1))))
! (goto-char (point-min)))
! (print-help-return-message))
;; If the *Faces* buffer appears in a different frame,
;; copy all the face definitions from FRAME,
;; so that the display will reflect the frame that was selected.
--- 1235,1241 ----
(while (not (eobp))
(insert-char ?\s max-length)
(forward-line 1))))
! (goto-char (point-min))))
;; If the *Faces* buffer appears in a different frame,
;; copy all the face definitions from FRAME,
;; so that the display will reflect the frame that was selected.
***************
*** 1280,1286 ****
(setq face 'default))
(if (not (listp face))
(setq face (list face)))
! (with-output-to-temp-buffer (help-buffer)
(save-excursion
(set-buffer standard-output)
(dolist (f face)
--- 1280,1286 ----
(setq face 'default))
(if (not (listp face))
(setq face (list face)))
! (with-help-window (help-buffer)
(save-excursion
(set-buffer standard-output)
(dolist (f face)
***************
*** 1326,1333 ****
(re-search-backward ": \\([^:]+\\)" nil t)
(help-xref-button 1 'help-face attr)))
(insert "\n")))))
! (terpri)))
! (print-help-return-message))))
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
--- 1326,1332 ----
(re-search-backward ": \\([^:]+\\)" nil t)
(help-xref-button 1 'help-face attr)))
(insert "\n")))))
! (terpri))))))
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
***************
*** 1505,1532 ****
(get face 'saved-face)
(face-default-spec face)))
- (defsubst face-normalize-spec (spec)
- "Return a normalized face-spec of SPEC."
- (let (normalized-spec)
- (while spec
- (let ((attribute (car spec))
- (value (car (cdr spec))))
- ;; Support some old-style attribute names and values.
- (case attribute
- (:bold (setq attribute :weight value (if value 'bold 'normal)))
- (:italic (setq attribute :slant value (if value 'italic 'normal)))
- ((:foreground :background)
- ;; Compatibility with 20.x. Some bogus face specs seem to
- ;; exist containing things like `:foreground nil'.
- (if (null value) (setq value 'unspecified)))
- (t (unless (assq attribute face-x-resources)
- (setq attribute nil))))
- (when attribute
- (push attribute normalized-spec)
- (push value normalized-spec)))
- (setq spec (cdr (cdr spec))))
- (nreverse normalized-spec)))
-
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Frame-type independent color support.
--- 1504,1509 ----
***************
*** 1669,1676 ****
;; be unmodified, so we can avoid consing in the common case.
(dolist (face (face-list))
(when (not (face-spec-match-p face
! (face-normalize-spec
! (face-user-default-spec face))
(selected-frame)))
(push face locally-modified-faces)))
;; Now change to the new frame parameters
--- 1646,1652 ----
;; be unmodified, so we can avoid consing in the common case.
(dolist (face (face-list))
(when (not (face-spec-match-p face
! (face-user-default-spec face)
(selected-frame)))
(push face locally-modified-faces)))
;; Now change to the new frame parameters
*** help-fns.el Wed Jul 25 06:47:20 2007
--- help-fns.el Thu Sep 27 08:11:54 2007
***************
*** 55,67 ****
(message "You didn't specify a function")
(help-setup-xref (list #'describe-function function) (interactive-p))
(save-excursion
! (with-output-to-temp-buffer (help-buffer)
(prin1 function)
;; Use " is " instead of a colon so that
;; it is easier to get out the function name using forward-sexp.
(princ " is ")
(describe-function-1 function)
- (print-help-return-message)
(with-current-buffer standard-output
;; Return the text we displayed.
(buffer-string))))))
--- 55,66 ----
(message "You didn't specify a function")
(help-setup-xref (list #'describe-function function) (interactive-p))
(save-excursion
! (with-help-window (help-buffer)
(prin1 function)
;; Use " is " instead of a colon so that
;; it is easier to get out the function name using forward-sexp.
(princ " is ")
(describe-function-1 function)
(with-current-buffer standard-output
;; Return the text we displayed.
(buffer-string))))))
***************
*** 232,237 ****
--- 231,253 ----
libname)
file))))
+ (defun find-source-lisp-file (file-name)
+ (let* ((elc-file (locate-file (concat file-name
+ (if (string-match "\\.el" file-name)
+ "c"
+ ".elc"))
+ load-path))
+ (str (if (and elc-file (file-readable-p elc-file))
+ (with-temp-buffer
+ (insert-file-contents-literally elc-file nil 0 256)
+ (buffer-string))))
+ (src-file (and str
+ (string-match ";;; from file \\(.*\\.el\\)" str)
+ (match-string 1 str))))
+ (if (and src-file (file-readable-p src-file))
+ src-file
+ file-name)))
+
;;;###autoload
(defun describe-function-1 (function)
(let* ((def (if (symbolp function)
***************
*** 309,314 ****
--- 325,334 ----
;; but that's completely wrong when the user used load-file.
(princ (if (eq file-name 'C-source) "C source code" file-name))
(princ "'")
+ ;; See if lisp files are present where they where installed from.
+ (if (not (eq file-name 'C-source))
+ (setq file-name (find-source-lisp-file file-name)))
+
;; Make a hyperlink to the library.
(with-current-buffer standard-output
(save-excursion
***************
*** 457,463 ****
val-start-pos)
(help-setup-xref (list #'describe-variable variable buffer)
(interactive-p))
! (with-output-to-temp-buffer (help-buffer)
(with-current-buffer buffer
(prin1 variable)
;; Make a hyperlink to the library if appropriate. (Don't
--- 477,483 ----
val-start-pos)
(help-setup-xref (list #'describe-variable variable buffer)
(interactive-p))
! (with-help-window (help-buffer)
(with-current-buffer buffer
(prin1 variable)
;; Make a hyperlink to the library if appropriate. (Don't
***************
*** 608,614 ****
(re-search-backward
(concat "\\(" customize-label "\\)") nil t)
(help-xref-button 1 'help-customize-variable variable)))))
- (print-help-return-message)
(save-excursion
(set-buffer standard-output)
;; Return the text we displayed.
--- 628,633 ----
***************
*** 623,629 ****
(interactive)
(setq buffer (or buffer (current-buffer)))
(help-setup-xref (list #'describe-syntax buffer) (interactive-p))
! (with-output-to-temp-buffer (help-buffer)
(let ((table (with-current-buffer buffer (syntax-table))))
(with-current-buffer standard-output
(describe-vector table 'internal-describe-syntax-value)
--- 642,648 ----
(interactive)
(setq buffer (or buffer (current-buffer)))
(help-setup-xref (list #'describe-syntax buffer) (interactive-p))
! (with-help-window (help-buffer)
(let ((table (with-current-buffer buffer (syntax-table))))
(with-current-buffer standard-output
(describe-vector table 'internal-describe-syntax-value)
***************
*** 648,654 ****
(interactive)
(setq buffer (or buffer (current-buffer)))
(help-setup-xref (list #'describe-categories buffer) (interactive-p))
! (with-output-to-temp-buffer (help-buffer)
(let ((table (with-current-buffer buffer (category-table))))
(with-current-buffer standard-output
(describe-vector table 'help-describe-category-set)
--- 667,673 ----
(interactive)
(setq buffer (or buffer (current-buffer)))
(help-setup-xref (list #'describe-categories buffer) (interactive-p))
! (with-help-window (help-buffer)
(let ((table (with-current-buffer buffer (category-table))))
(with-current-buffer standard-output
(describe-vector table 'help-describe-category-set)
*** help-mode.el Sun Aug 12 10:00:02 2007
--- help-mode.el Mon Aug 27 09:51:10 2007
***************
*** 40,45 ****
--- 40,46 ----
(define-key help-mode-map [mouse-2] 'help-follow-mouse)
(define-key help-mode-map "\C-c\C-b" 'help-go-back)
+ (define-key help-mode-map "\C-c\C-f" 'help-go-forward)
(define-key help-mode-map "\C-c\C-c" 'help-follow-symbol)
;; Documentation only, since we use minor-mode-overriding-map-alist.
(define-key help-mode-map "\r" 'help-follow)
***************
*** 52,64 ****
--- 53,80 ----
(put 'help-xref-stack 'permanent-local t)
(make-variable-buffer-local 'help-xref-stack)
+ (defvar help-xref-forward-stack nil
+ "The stack of used to navigate help forwards after using the back button.
+ Used by `help-follow' and `help-xref-go-forward'.
+ An element looks like (POSITION FUNCTION ARGS...).
+ To use the element, do (apply FUNCTION ARGS) then goto the point.")
+ (put 'help-xref-forward-stack 'permanent-local t)
+ (make-variable-buffer-local 'help-xref-forward-stack)
+
(defvar help-xref-stack-item nil
"An item for `help-follow' in this buffer to push onto `help-xref-stack'.
The format is (FUNCTION ARGS...).")
(put 'help-xref-stack-item 'permanent-local t)
(make-variable-buffer-local 'help-xref-stack-item)
+ (defvar help-xref-stack-forward-item nil
+ "An item for `help-go-back' to push onto `help-xref-forward-stack'.
+ The format is (FUNCTION ARGS...).")
+ (put 'help-xref-stack-forward-item 'permanent-local t)
+ (make-variable-buffer-local 'help-xref-stack-forward-item)
+
(setq-default help-xref-stack nil help-xref-stack-item nil)
+ (setq-default help-xref-forward-stack nil help-xref-forward-stack-item nil)
(defcustom help-mode-hook nil
"Hook run by `help-mode'."
***************
*** 123,128 ****
--- 139,149 ----
'help-function #'help-xref-go-back
'help-echo (purecopy "mouse-2, RET: go back to previous help buffer"))
+ (define-button-type 'help-forward
+ :supertype 'help-xref
+ 'help-function #'help-xref-go-forward
+ 'help-echo (purecopy "mouse-2, RET: move forward to next help buffer"))
+
(define-button-type 'help-info
:supertype 'help-xref
'help-function #'info
***************
*** 201,212 ****
(setq mode-name "Help")
(setq major-mode 'help-mode)
(view-mode)
! (make-local-variable 'view-no-disable-on-exit)
! (setq view-no-disable-on-exit t)
! (setq view-exit-action (lambda (buffer)
! (or (window-minibuffer-p (selected-window))
! (one-window-p t)
! (delete-window))))
(run-mode-hooks 'help-mode-hook))
;;;###autoload
--- 222,235 ----
(setq mode-name "Help")
(setq major-mode 'help-mode)
(view-mode)
! (set (make-local-variable 'view-no-disable-on-exit) t)
! (setq view-exit-action
! (lambda (buffer)
! (with-current-buffer buffer
! ;; Use `with-current-buffer' to assert that `bury-buffer'
! ;; removes buffer from the selected window. Leave it to
! ;; `view-mode-exit' to delete the associated window(s).
! (bury-buffer))))
(run-mode-hooks 'help-mode-hook))
;;;###autoload
***************
*** 216,231 ****
;;;###autoload
(defun help-mode-finish ()
! (let ((entry (assq (selected-window) view-return-to-alist)))
! (if entry
! ;; When entering Help mode from the Help window,
! ;; such as by following a link, preserve the same
! ;; meaning for the q command.
! ;; (setcdr entry (cons (selected-window) help-return-method))
! nil
! (setq view-return-to-alist
! (cons (cons (selected-window) help-return-method)
! view-return-to-alist))))
(when (eq major-mode 'help-mode)
;; View mode's read-only status of existing *Help* buffer is lost
;; by with-output-to-temp-buffer.
--- 239,262 ----
;;;###autoload
(defun help-mode-finish ()
! (if help-window-list
! ;; If `help-window-list' is non-nil, `view-return-to-alist'
! ;; is handled by `help-window-finish'. We just prepend the
! ;; selected window to `help-window-list' here since now is
! ;; the only moment where we can unambiguously identify it.
! (setq help-window-list
! (cons (selected-window) help-window-list))
! (let ((entry (assq (selected-window) view-return-to-alist)))
! (if entry
! ;; When entering Help mode from the Help window,
! ;; such as by following a link, preserve the same
! ;; meaning for the q command.
! ;; (setcdr entry (cons (selected-window) help-return-method))
! nil
! (setq view-return-to-alist
! (cons (cons (selected-window) help-return-method)
! view-return-to-alist)))))
!
(when (eq major-mode 'help-mode)
;; View mode's read-only status of existing *Help* buffer is lost
;; by with-output-to-temp-buffer.
***************
*** 242,247 ****
--- 273,281 ----
(defvar help-back-label (purecopy "[back]")
"Label to use by `help-make-xrefs' for the go-back reference.")
+ (defvar help-forward-label (purecopy "[forward]")
+ "Label to use by `help-make-xrefs' for the go-forward reference.")
+
(defconst help-xref-symbol-regexp
(purecopy (concat "\\(\\<\\(\\(variable\\|option\\)\\|" ; Link to var
"\\(function\\|command\\)\\|" ; Link to function
***************
*** 286,292 ****
restore it properly when going back."
(with-current-buffer (help-buffer)
(when help-xref-stack-item
! (push (cons (point) help-xref-stack-item) help-xref-stack))
(when interactive-p
(let ((tail (nthcdr 10 help-xref-stack)))
;; Truncate the stack.
--- 320,327 ----
restore it properly when going back."
(with-current-buffer (help-buffer)
(when help-xref-stack-item
! (push (cons (point) help-xref-stack-item) help-xref-stack)
! (setq help-xref-forward-stack nil))
(when interactive-p
(let ((tail (nthcdr 10 help-xref-stack)))
;; Truncate the stack.
***************
*** 477,487 ****
(while (and (not (bobp)) (bolp))
(delete-char -1))
(insert "\n")
;; Make a back-reference in this buffer if appropriate.
(when help-xref-stack
- (insert "\n")
(help-insert-xref-button help-back-label 'help-back
! (current-buffer))
(insert "\n")))
;; View mode steals RET from us.
(set (make-local-variable 'minor-mode-overriding-map-alist)
--- 512,530 ----
(while (and (not (bobp)) (bolp))
(delete-char -1))
(insert "\n")
+ (when (or help-xref-stack help-xref-forward-stack)
+ (insert "\n"))
;; Make a back-reference in this buffer if appropriate.
(when help-xref-stack
(help-insert-xref-button help-back-label 'help-back
! (current-buffer)))
! ;; Make a forward-reference in this buffer if appropriate.
! (when help-xref-forward-stack
! (when help-xref-stack
! (insert "\t"))
! (help-insert-xref-button help-forward-label 'help-forward
! (current-buffer)))
! (when (or help-xref-stack help-xref-forward-stack)
(insert "\n")))
;; View mode steals RET from us.
(set (make-local-variable 'minor-mode-overriding-map-alist)
***************
*** 600,605 ****
--- 643,649 ----
"From BUFFER, go back to previous help buffer text using `help-xref-stack'."
(let (item position method args)
(with-current-buffer buffer
+ (push (cons (point) help-xref-stack-item) help-xref-forward-stack)
(when help-xref-stack
(setq item (pop help-xref-stack)
;; Clear the current item so that it won't get pushed
***************
*** 615,626 ****
--- 659,697 ----
(set-window-point (get-buffer-window buffer) position)
(goto-char position)))))
+ (defun help-xref-go-forward (buffer)
+ "From BUFFER, go forward to next help buffer."
+ (let (item position method args)
+ (with-current-buffer buffer
+ (push (cons (point) help-xref-stack-item) help-xref-stack)
+ (when help-xref-forward-stack
+ (setq item (pop help-xref-forward-stack)
+ ;; Clear the current item so that it won't get pushed
+ ;; by the function we're about to call. TODO: We could also
+ ;; push it onto a "forward" stack and add a `forw' button.
+ help-xref-stack-item nil
+ position (car item)
+ method (cadr item)
+ args (cddr item))))
+ (apply method args)
+ (with-current-buffer buffer
+ (if (get-buffer-window buffer)
+ (set-window-point (get-buffer-window buffer) position)
+ (goto-char position)))))
+
(defun help-go-back ()
"Go back to previous topic in this help buffer."
(interactive)
(if help-xref-stack
(help-xref-go-back (current-buffer))
(error "No previous help buffer")))
+
+ (defun help-go-forward ()
+ "Go back to next topic in this help buffer."
+ (interactive)
+ (if help-xref-forward-stack
+ (help-xref-go-forward (current-buffer))
+ (error "No next help buffer")))
(defun help-do-xref (pos function args)
"Call the help cross-reference function FUNCTION with args ARGS.
*** help.el Mon Aug 6 07:56:36 2007
--- help.el Thu Sep 27 08:30:54 2007
***************
*** 123,128 ****
--- 123,130 ----
If FUNCTION is nil, it applies `message', thus displaying the message.
In addition, this function sets up `help-return-method', which see, that
specifies what to do when the user exits the help buffer."
+ ;; Reset `help-window-list' to avoid messing up `help-mode-finish'.
+ (setq help-window-list nil)
(and (not (get-buffer-window standard-output))
(let ((first-message
(cond ((or
***************
*** 429,435 ****
To record all your input on a file, use `open-dribble-file'."
(interactive)
(help-setup-xref (list #'view-lossage) (interactive-p))
! (with-output-to-temp-buffer (help-buffer)
(princ (mapconcat (lambda (key)
(if (or (integerp key) (symbolp key) (listp key))
(single-key-description key)
--- 431,437 ----
To record all your input on a file, use `open-dribble-file'."
(interactive)
(help-setup-xref (list #'view-lossage) (interactive-p))
! (with-help-window (help-buffer)
(princ (mapconcat (lambda (key)
(if (or (integerp key) (symbolp key) (listp key))
(single-key-description key)
***************
*** 441,448 ****
(while (progn (move-to-column 50) (not (eobp)))
(when (search-forward " " nil t)
(delete-char -1))
! (insert "\n")))
! (print-help-return-message)))
\f
;; Key bindings
--- 443,449 ----
(while (progn (move-to-column 50) (not (eobp)))
(when (search-forward " " nil t)
(delete-char -1))
! (insert "\n")))))
\f
;; Key bindings
***************
*** 717,723 ****
(setq sequence (vector up-event))
(aset sequence 0 'mouse-1)
(setq defn-up-tricky (key-binding sequence nil nil (event-start up-event))))))
! (with-output-to-temp-buffer (help-buffer)
(princ (help-key-description key untranslated))
(princ (format "\
%s runs the command %S
--- 718,724 ----
(setq sequence (vector up-event))
(aset sequence 0 'mouse-1)
(setq defn-up-tricky (key-binding sequence nil nil (event-start up-event))))))
! (with-help-window (help-buffer)
(princ (help-key-description key untranslated))
(princ (format "\
%s runs the command %S
***************
*** 753,760 ****
ev-type mouse-msg
mouse-1-click-follows-link
defn-up-tricky))
! (describe-function-1 defn-up-tricky)))
! (print-help-return-message)))))
\f
(defun describe-mode (&optional buffer)
"Display documentation of current major mode and minor modes.
--- 754,760 ----
ev-type mouse-msg
mouse-1-click-follows-link
defn-up-tricky))
! (describe-function-1 defn-up-tricky)))))))
\f
(defun describe-mode (&optional buffer)
"Display documentation of current major mode and minor modes.
***************
*** 771,777 ****
(interactive-p))
;; For the sake of help-do-xref and help-xref-go-back,
;; don't switch buffers before calling `help-buffer'.
! (with-output-to-temp-buffer (help-buffer)
(with-current-buffer buffer
(let (minor-modes)
;; Older packages do not register in minor-mode-list but only in
--- 771,777 ----
(interactive-p))
;; For the sake of help-do-xref and help-xref-go-back,
;; don't switch buffers before calling `help-buffer'.
! (with-help-window (help-buffer)
(with-current-buffer buffer
(let (minor-modes)
;; Older packages do not register in minor-mode-list but only in
***************
*** 839,846 ****
(insert (format-mode-line mode))
(add-text-properties start (point) '(face bold)))))
(princ " mode:\n")
! (princ (documentation major-mode)))
! (print-help-return-message))))
(defun describe-minor-mode (minor-mode)
--- 839,845 ----
(insert (format-mode-line mode))
(add-text-properties start (point) '(face bold)))))
(princ " mode:\n")
! (princ (documentation major-mode))))))
(defun describe-minor-mode (minor-mode)
***************
*** 973,978 ****
--- 972,1182 ----
temp-buffer-max-height))))
\f
+ ;;; help-window
+
+ (defcustom help-window-select 'other
+ "Non-nil means select help window for viewing.
+ Choices are:
+
+ never .... select help window only if there's no other window
+
+ other .... select help window unless it's the only other window
+
+ always ... always select the help window."
+ :type '(choice (const :tag "never" nil)
+ (const :tag "other" other)
+ (const :tag "always" t))
+ :group 'help
+ :version "23.1")
+
+ ;; At the time `help-window-list' is read by `help-window-finish' it's a
+ ;; list composed as follows:
+
+ ;; nth 0 ... the window selected by `display-buffer' (prepended by
+ ;; `help-mode-finish'). `help-window-finish' may try to
+ ;; select that window according to the current value of
+ ;; `help-window-select'.
+
+ ;; nth 1 ... the window selected when `with-help-window' was invoked
+ ;; (set by `help-window-setup'). `help-window-finish' will
+ ;; try to install an entry in `view-return-to-alist' to
+ ;; reselect this window when the user quits help.
+
+ ;; nth 2..n ... a (window window-buffer window-start window-point)
+ ;; quadruple for each window displayed at the time
+ ;; `with-help-window' was invoked (set by
+ ;; `help-window-setup'). `help-window-finish' may use this
+ ;; information to restore the previous contents of the window
+ ;; displaying help information when the user quits help.
+ (defvar help-window-list nil)
+
+ (defun help-window-setup ()
+ "Setup `help-window-list' before displaying the help buffer."
+ (walk-windows
+ (lambda (window)
+ ;; Add (window window-buffer window-start window-point) quadruple
+ ;; for each live window.
+ (setq help-window-list
+ (cons
+ (list window (window-buffer window)
+ (window-start window) (window-point window))
+ help-window-list)))
+ 'no-mini t)
+ ;; Prepend the selected window.
+ (setq help-window-list
+ (cons (selected-window) help-window-list)))
+
+ (defun help-window-scrolling-text (window &optional other)
+ "Return string telling how to scroll help window WINDOW.
+ Optional argument OTHER non-nil means return text telling how to
+ scroll the other window. Return \".\" if the end of the buffer
+ displayed in WINDOW is visible in WINDOW."
+ (cond
+ ((pos-visible-in-window-p
+ (with-current-buffer (window-buffer window)
+ (point-max)) window)
+ ;; Buffer end is visible.
+ ".")
+ (other ", \\[scroll-other-window] to scroll help.")
+ (t ", \\[scroll-up] to scroll help.")))
+
+ (defun help-window-select-window (window &optional reuse)
+ "If appropriate select help window WINDOW and display message.
+ WINDOW is selected if the current value of the variable
+ `help-window-select' demands it. A message is displayed only if
+ it makes sense in the present context.
+
+ Use this function only if WINDOW's buffer is in `view-mode'.
+ Otherwise, the displayed message might not make sense."
+ (let ((frame (window-frame window)))
+ (cond
+ ;; Comment in the following in case we should care iff help window
+ ;; and selected window are on the same frame.
+ ;;; ((not (eq frame (window-frame (selected-window)))))
+ ((eq window (selected-window))
+ ;; Probably the `pop-up-windows' nil case, tell how to quit
+ ;; view-mode and scroll the window.
+ (message
+ (substitute-command-keys
+ (concat "Type \"q\" to quit" (help-window-scrolling-text window)))))
+ ((= (length (window-list frame 'no-mini)) 2)
+ ;; There are two windows on the help window's frame.
+ (if (memq help-window-select '(nil other))
+ ;; The user doesn't want to select the help window.
+ (if reuse
+ ;; Offer `display-buffer' for consistency with
+ ;; `print-help-return-message'.
+ (message
+ (substitute-command-keys
+ (concat "Type \\[display-buffer] RET to restore the other window"
+ (help-window-scrolling-text window t))))
+ ;; The classic "two windows" configuration.
+ (message
+ (substitute-command-keys
+ (concat "Type \\[delete-other-windows] to quit"
+ (help-window-scrolling-text window t)))))
+ ;; Select help window and offer view-mode's quit.
+ (select-window window)
+ (message
+ (substitute-command-keys
+ (concat "Type \"q\" to quit"
+ (help-window-scrolling-text window))))))
+ ;; Issuing a message when we reuse one out of >= 3 windows on the
+ ;; same frame without also selecting that window doesn't make any
+ ;; sense. We leave it to `view-mode-exit' to DTRT when the user
+ ;; eventually selects that window and types "q". Below we handle
+ ;; only the case where the help window gets selected by us.
+ (help-window-select
+ ;; Select help window and offer view-mode's quit.
+ (select-window window)
+ (message
+ (substitute-command-keys
+ (concat "Type \"q\" to quit"
+ (help-window-scrolling-text window))))))))
+
+ (defun help-window-finish ()
+ "Process `help-window-list' after displaying the help buffer."
+ (let* ((window (car help-window-list))
+ (buffer (window-buffer window))
+ ;; `window' is now the help window and `buffer' it's buffer.
+ (old-window (cadr help-window-list))
+ ;; `old-window' is the window selected at the time help was
+ ;; invoked.
+ entry)
+ ;; The following conditional has to work with _any_ window selected
+ ;; and _any_ buffer current: `help-window-select-window' must be
+ ;; able to select `window' and make `buffer' current. Hence, using
+ ;; `with-current-buffer' wouldn't make sense here.
+ (cond
+ ((setq entry
+ (assq window
+ (buffer-local-value 'view-return-to-alist buffer)))
+ ;; `view-return-to-alist' has an entry for `window'.
+ (if (eq window old-window)
+ ;; If the help window is the same as the window selected at
+ ;; the time help was invoked, it's probably the result of
+ ;; following a backward/forward button or a cross reference.
+ ;; In this case, just purge stale entries from the buffer's
+ ;; `view-return-to-alist' but leave `entry' alone.
+ (view-return-to-alist-update buffer)
+ ;; We had an existing view-mode window but help was invoked
+ ;; while another one was selected. In this case, reuse exit
+ ;; information from old entry but try to select `old-window'
+ ;; when the user quits.
+ (view-return-to-alist-update
+ buffer (cons window (cons old-window (cddr entry))))
+ (help-window-select-window window)))
+ ((setq entry (assq window (cddr help-window-list)))
+ ;; `view-return-to-alist' didn't have an entry for `window' but
+ ;; `help-window-list' did; so we know that `display-buffer' has
+ ;; reused an existing window.
+ (if (eq (cadr entry) buffer)
+ ;; The help window displayed the help buffer before but no
+ ;; `view-return-to-alist' entry was found probably because the
+ ;; user manually switched to the help buffer. Let `View-quit'
+ ;; do `quit-window' although `view-exit-action' should be able
+ ;; to handle this case all by itself.
+ (progn
+ (view-return-to-alist-update
+ buffer (cons window (cons (selected-window) 'quit-window)))
+ (help-window-select-window window t))
+ ;; The help window displayed another buffer before. Set up
+ ;; things so `View-quit' can orderly show that buffer again.
+ ;; It's this case which necessitates to add window-start and
+ ;; window-point information to `help-window-list'.
+ (view-return-to-alist-update
+ buffer (cons window (cons (selected-window) (cdr entry))))
+ (help-window-select-window window t)))
+ (t
+ ;; No entry found for `window'. This means `display-buffer' has
+ ;; created a new window that should be deleted by `View-quit'.
+ (view-return-to-alist-update
+ buffer (cons window (cons (selected-window) t)))
+ (help-window-select-window window)))))
+
+ (defmacro with-help-window (buffer-name &rest body)
+ "Show buffer BUFFER-NAME in a help window evaluating BODY.
+ This macro provides the behavior of `with-output-to-temp-buffer'
+ paired with `print-help-return-message' and the following twists:
+
+ - The help window may be selected according to the value of the
+ customizable variable `help-window-select'.
+
+ - Quitting the help window with `View-quit' should restore the
+ associated frame's previous state more accurately.
+
+ - Messages telling how to quit the help window should be more
+ accurate.
+
+ Caution: Using `print-help-return-message' in BODY will make
+ with-help-window behave like `with-output-to-temp-buffer'."
+ (declare (indent 1) (debug t))
+ `(let (help-window-list)
+ (help-window-setup)
+ (with-output-to-temp-buffer ,buffer-name
+ (progn ,@body))
+ (help-window-finish)))
+ \f
(provide 'help)
;; arch-tag: cf427352-27e9-49b7-9a6f-741ebab02423
*** view.el Thu Sep 27 07:39:12 2007
--- view.el Thu Sep 27 07:53:08 2007
***************
*** 146,155 ****
(put 'view-return-to-alist 'permanent-local t)
(defvar view-exit-action nil
! "nil or a function with one argument (a buffer) called when finished viewing.
! This is local in each buffer being viewed.
! The \\[view-file] and \\[view-file-other-window] commands may set this to
! `kill-buffer'.")
(make-variable-buffer-local 'view-exit-action)
(defvar view-no-disable-on-exit nil
--- 146,156 ----
(put 'view-return-to-alist 'permanent-local t)
(defvar view-exit-action nil
! "If non-nil a function with one argument (a buffer) called when finished viewing.
! This is local in each buffer being viewed. The \\[view-file] and
! \\[view-file-other-window] commands may set this to `kill-buffer'.
! Observe that the buffer might not appear in any window when this
! function is called.")
(make-variable-buffer-local 'view-exit-action)
(defvar view-no-disable-on-exit nil
***************
*** 241,251 ****
;;;###autoload
(defun view-file (file)
"View FILE in View mode, returning to previous buffer when done.
! Emacs commands editing the buffer contents are not available; instead,
! a special set of commands (mostly letters and punctuation)
! are defined for moving around in the buffer.
Space scrolls forward, Delete scrolls backward.
! For list of all View commands, type H or h while viewing.
This command runs the normal hook `view-mode-hook'."
(interactive "fView file: ")
--- 242,252 ----
;;;###autoload
(defun view-file (file)
"View FILE in View mode, returning to previous buffer when done.
! Emacs commands editing the buffer contents are not available; instead, a
! special set of commands (mostly letters and punctuation) are defined for
! moving around in the buffer.
Space scrolls forward, Delete scrolls backward.
! For a list of all View commands, type H or h while viewing.
This command runs the normal hook `view-mode-hook'."
(interactive "fView file: ")
***************
*** 263,274 ****
;;;###autoload
(defun view-file-other-window (file)
"View FILE in View mode in another window.
! Return that window to its previous buffer when done.
! Emacs commands editing the buffer contents are not available; instead,
! a special set of commands (mostly letters and punctuation)
! are defined for moving around in the buffer.
Space scrolls forward, Delete scrolls backward.
! For list of all View commands, type H or h while viewing.
This command runs the normal hook `view-mode-hook'."
(interactive "fIn other window view file: ")
--- 264,275 ----
;;;###autoload
(defun view-file-other-window (file)
"View FILE in View mode in another window.
! Return that window to its previous buffer when done. Emacs commands
! editing the buffer contents are not available; instead, a special set of
! commands (mostly letters and punctuation) are defined for moving around
! in the buffer.
Space scrolls forward, Delete scrolls backward.
! For a list of all View commands, type H or h while viewing.
This command runs the normal hook `view-mode-hook'."
(interactive "fIn other window view file: ")
***************
*** 281,291 ****
(defun view-file-other-frame (file)
"View FILE in View mode in another frame.
Maybe delete other frame and/or return to previous buffer when done.
! Emacs commands editing the buffer contents are not available; instead,
! a special set of commands (mostly letters and punctuation)
! are defined for moving around in the buffer.
Space scrolls forward, Delete scrolls backward.
! For list of all View commands, type H or h while viewing.
This command runs the normal hook `view-mode-hook'."
(interactive "fIn other frame view file: ")
--- 282,292 ----
(defun view-file-other-frame (file)
"View FILE in View mode in another frame.
Maybe delete other frame and/or return to previous buffer when done.
! Emacs commands editing the buffer contents are not available; instead, a
! special set of commands (mostly letters and punctuation) are defined for
! moving around in the buffer.
Space scrolls forward, Delete scrolls backward.
! For a list of all View commands, type H or h while viewing.
This command runs the normal hook `view-mode-hook'."
(interactive "fIn other frame view file: ")
***************
*** 298,315 ****
;;;###autoload
(defun view-buffer (buffer &optional exit-action)
"View BUFFER in View mode, returning to previous buffer when done.
! Emacs commands editing the buffer contents are not available; instead,
! a special set of commands (mostly letters and punctuation)
! are defined for moving around in the buffer.
Space scrolls forward, Delete scrolls backward.
! For list of all View commands, type H or h while viewing.
This command runs the normal hook `view-mode-hook'.
Optional argument EXIT-ACTION is either nil or a function with buffer as
! argument. This function is called when finished viewing buffer.
! Use this argument instead of explicitly setting `view-exit-action'."
!
(interactive "bView buffer: ")
(let ((undo-window (list (window-buffer) (window-start) (window-point))))
(switch-to-buffer buffer)
--- 299,315 ----
;;;###autoload
(defun view-buffer (buffer &optional exit-action)
"View BUFFER in View mode, returning to previous buffer when done.
! Emacs commands editing the buffer contents are not available; instead, a
! special set of commands (mostly letters and punctuation) are defined for
! moving around in the buffer.
Space scrolls forward, Delete scrolls backward.
! For a list of all View commands, type H or h while viewing.
This command runs the normal hook `view-mode-hook'.
Optional argument EXIT-ACTION is either nil or a function with buffer as
! argument. This function is called when finished viewing buffer. Use
! this argument instead of explicitly setting `view-exit-action'."
(interactive "bView buffer: ")
(let ((undo-window (list (window-buffer) (window-start) (window-point))))
(switch-to-buffer buffer)
***************
*** 319,336 ****
;;;###autoload
(defun view-buffer-other-window (buffer &optional not-return exit-action)
"View BUFFER in View mode in another window.
! Return to previous buffer when done, unless optional NOT-RETURN is non-nil.
! Emacs commands editing the buffer contents are not available; instead,
! a special set of commands (mostly letters and punctuation)
! are defined for moving around in the buffer.
Space scrolls forward, Delete scrolls backward.
! For list of all View commands, type H or h while viewing.
This command runs the normal hook `view-mode-hook'.
Optional argument EXIT-ACTION is either nil or a function with buffer as
! argument. This function is called when finished viewing buffer.
! Use this argument instead of explicitly setting `view-exit-action'."
(interactive "bIn other window view buffer:\nP")
(let* ((win ; This window will be selected by
(get-lru-window)) ; switch-to-buffer-other-window below.
--- 319,336 ----
;;;###autoload
(defun view-buffer-other-window (buffer &optional not-return exit-action)
"View BUFFER in View mode in another window.
! Return to previous buffer when done, unless optional NOT-RETURN is
! non-nil. Emacs commands editing the buffer contents are not available;
! instead, a special set of commands (mostly letters and punctuation) are
! defined for moving around in the buffer.
Space scrolls forward, Delete scrolls backward.
! For a list of all View commands, type H or h while viewing.
This command runs the normal hook `view-mode-hook'.
Optional argument EXIT-ACTION is either nil or a function with buffer as
! argument. This function is called when finished viewing buffer. Use
! this argument instead of explicitly setting `view-exit-action'."
(interactive "bIn other window view buffer:\nP")
(let* ((win ; This window will be selected by
(get-lru-window)) ; switch-to-buffer-other-window below.
***************
*** 350,367 ****
;;;###autoload
(defun view-buffer-other-frame (buffer &optional not-return exit-action)
"View BUFFER in View mode in another frame.
! Return to previous buffer when done, unless optional NOT-RETURN is non-nil.
! Emacs commands editing the buffer contents are not available; instead,
! a special set of commands (mostly letters and punctuation)
! are defined for moving around in the buffer.
Space scrolls forward, Delete scrolls backward.
! For list of all View commands, type H or h while viewing.
This command runs the normal hook `view-mode-hook'.
Optional argument EXIT-ACTION is either nil or a function with buffer as
! argument. This function is called when finished viewing buffer.
! Use this argument instead of explicitly setting `view-exit-action'."
(interactive "bView buffer in other frame: \nP")
(let ((return-to
(and (not not-return) (cons (selected-window) t)))) ; Old window.
--- 350,367 ----
;;;###autoload
(defun view-buffer-other-frame (buffer &optional not-return exit-action)
"View BUFFER in View mode in another frame.
! Return to previous buffer when done, unless optional NOT-RETURN is
! non-nil. Emacs commands editing the buffer contents are not available;
! instead, a special set of commands (mostly letters and punctuation) are
! defined for moving around in the buffer.
Space scrolls forward, Delete scrolls backward.
! For a list of all View commands, type H or h while viewing.
This command runs the normal hook `view-mode-hook'.
Optional argument EXIT-ACTION is either nil or a function with buffer as
! argument. This function is called when finished viewing buffer. Use
! this argument instead of explicitly setting `view-exit-action'."
(interactive "bView buffer in other frame: \nP")
(let ((return-to
(and (not not-return) (cons (selected-window) t)))) ; Old window.
***************
*** 375,382 ****
;; bindings instead of using the \\[] construction. The reason for this
;; is that most commands have more than one key binding.
"Toggle View mode, a minor mode for viewing text but not editing it.
! With prefix argument ARG, turn View mode on if ARG is positive, otherwise
! turn it off.
Emacs commands that do not change the buffer contents are available as usual.
Kill commands insert text in kill buffers but do not delete. Other commands
--- 375,381 ----
;; bindings instead of using the \\[] construction. The reason for this
;; is that most commands have more than one key binding.
"Toggle View mode, a minor mode for viewing text but not editing it.
! With ARG, turn View mode on iff ARG is positive.
Emacs commands that do not change the buffer contents are available as usual.
Kill commands insert text in kill buffers but do not delete. Other commands
***************
*** 495,500 ****
--- 494,531 ----
(setq buffer-read-only view-old-buffer-read-only)))
;;;###autoload
+ (defun view-return-to-alist-update (buffer &optional item)
+ "Update `view-return-to-alist' of buffer BUFFER.
+ Any entries referencing the selected window as well as entries
+ referencing dead windows are purged from `view-return-to-alist'. Adds
+ optional argument ITEM to `view-return-to-alist' after updating. For a
+ decsription of items that can be added compare the RETURN-TO-ALIST
+ argument of the function `view-mode-exit'."
+ (with-current-buffer buffer
+ (when view-return-to-alist
+ (let* ((list view-return-to-alist)
+ entry entry-window last)
+ ;; cdr-down list.
+ (while list
+ (setq entry (car list))
+ (setq entry-window (car entry))
+ (if (and (windowp entry-window)
+ (or (and item (eq entry-window (selected-window)))
+ (not (window-live-p entry-window))))
+ ;; Remove that entry.
+ (if last
+ (setcdr last (cdr list))
+ (setq view-return-to-alist
+ (cdr view-return-to-alist)))
+ ;; Leave entry alone.
+ (setq last entry))
+ (setq list (cdr list)))))
+ ;; Add ITEM.
+ (when item
+ (setq view-return-to-alist
+ (cons item view-return-to-alist)))))
+
+ ;;;###autoload
(defun view-mode-enter (&optional return-to exit-action) "\
Enter View mode and set up exit from view mode depending on optional arguments.
If RETURN-TO is non-nil it is added as an element to the buffer local alist
***************
*** 532,619 ****
\f
(defun view-mode-exit (&optional return-to-alist exit-action all-win)
"Exit View mode in various ways, depending on optional arguments.
! RETURN-TO-ALIST, EXIT-ACTION and ALL-WIN determine what to do after exit.
! EXIT-ACTION is nil or a function that is called with current buffer as
! argument.
! RETURN-TO-ALIST is an alist that for some of the windows displaying the
! current buffer, associate information on what to do with those windows.
! If ALL-WIN or the variable `view-exits-all-viewing-windows' is non-nil,
! then all windows on RETURN-TO-ALIST are restored to their old state.
! Otherwise only the selected window is affected (if it is on RETURN-TO-ALIST).
!
! Elements of RETURN-TO-ALIST have the format (WINDOW OLD-WINDOW . OLD-BUF-INFO).
! WINDOW is a window displaying the current buffer.
! OLD-WINDOW is nil or a window to select after viewing.
! OLD-BUF-INFO is information on what to do with WINDOW and is one of:
1) nil Do nothing.
2) t Delete WINDOW and, if it is the only window, its frame.
3) (OLD-BUF START POINT) Display buffer OLD-BUF with displayed text
starting at START and point at POINT in WINDOW.
4) quit-window Do `quit-window' in WINDOW.
! If one of the WINDOW in RETURN-TO-ALIST is the selected window and the
! corresponding OLD-WINDOW is a live window, then select OLD-WINDOW."
! (setq all-win
! (and return-to-alist (or all-win view-exits-all-viewing-windows)))
! (if view-mode ; Only do something if in view mode.
! (let* ((buffer (current-buffer))
! window notlost
! (sel-old (assq (selected-window) return-to-alist))
! (alist (cond
! (all-win ; Try to restore all windows.
! (append return-to-alist nil)) ; Copy.
! (sel-old ; Only selected window.
! (list sel-old))))
! (old-window (if sel-old (car (cdr sel-old)))))
! (if all-win ; Follow chains of old-windows.
! (let ((c (length alist)) a)
! (while (and (> c 0) ; Safety if mutually refering windows.
! (or (not (window-live-p old-window))
! (eq buffer (window-buffer old-window)))
! (setq a (assq old-window alist)))
! (setq c (1- c))
! (setq old-window (car (cdr a))))
! (if (or (zerop c) (not (window-live-p old-window)))
! (setq old-window (selected-window)))))
! (or view-no-disable-on-exit
! (view-mode-disable))
! (while alist ; Restore windows with info.
! (setq notlost nil)
! (if (and (window-live-p (setq window (car (car alist))))
(eq buffer (window-buffer window)))
! (let ((frame (window-frame window))
! (old-buf-info (cdr (cdr (car alist)))))
! (if all-win (select-window window))
! (cond
! ((and (consp old-buf-info) ; Case 3.
! (buffer-live-p (car old-buf-info)))
! (set-window-buffer window (car old-buf-info)) ; old-buf
! (set-window-start window (car (cdr old-buf-info)))
! (set-window-point window (car (cdr (cdr old-buf-info)))))
! ((eq old-buf-info 'quit-window)
! (quit-window)) ; Case 4.
! ((not (eq old-buf-info t)) nil) ; Not case 2, do nothing.
! ((not (one-window-p t)) (delete-window))
! ((not (eq frame (next-frame)))
! ;; Not the only frame, so can safely be removed.
! (if view-remove-frame-by-deleting
! (delete-frame frame)
! (setq notlost t) ; Keep the window. See below.
! (iconify-frame frame))))))
! ;; If a frame is removed by iconifying it, then the window is not
! ;; really lost. In this case we keep the entry in
! ;; view-return-to-alist so that if the user deiconifies the frame
! ;; and then press q, then the frame is iconified again.
! (unless notlost
(setq view-return-to-alist
! (delete (car alist) view-return-to-alist)))
! (setq alist (cdr alist)))
! (if (window-live-p old-window) ; still existing window
! (select-window old-window))
! (when exit-action
! (setq view-exit-action nil)
! (funcall exit-action buffer))
! (force-mode-line-update))))
\f
(defun View-exit ()
"Exit View mode but stay in current buffer."
--- 563,659 ----
\f
(defun view-mode-exit (&optional return-to-alist exit-action all-win)
"Exit View mode in various ways, depending on optional arguments.
! RETURN-TO-ALIST, EXIT-ACTION and ALL-WIN determine what to do
! after exit. EXIT-ACTION is nil or a function that is called with
! current buffer as argument.
!
! RETURN-TO-ALIST is an alist that, for some of the windows
! displaying the current buffer, maintains information on what to
! do when exiting those windows. If ALL-WIN is non-nil or the
! variable `view-exits-all-viewing-windows' is non-nil,
! view-mode-exit attempts to restore all windows showing the
! current buffer to their old state. Otherwise, only the selected
! window is affected (provided it is on RETURN-TO-ALIST).
!
! Elements of RETURN-TO-ALIST must have the format
! (WINDOW OLD-WINDOW . OLD-BUF-INFO) where
!
! WINDOW is a window displaying the current buffer and OLD-WINDOW
! is either nil or a window to select after viewing. OLD-BUF-INFO
! keeps information on what to do with WINDOW and may be one of:
1) nil Do nothing.
2) t Delete WINDOW and, if it is the only window, its frame.
3) (OLD-BUF START POINT) Display buffer OLD-BUF with displayed text
starting at START and point at POINT in WINDOW.
4) quit-window Do `quit-window' in WINDOW.
! If one of the WINDOWs in RETURN-TO-ALIST is the selected window
! and the corresponding OLD-WINDOW is a live window, then select
! OLD-WINDOW."
! (when view-mode ; Only do something if in view mode.
! (setq all-win
! (and return-to-alist
! (or all-win view-exits-all-viewing-windows)))
! (let* ((buffer (current-buffer))
! window notlost
! (sel-old (assq (selected-window) return-to-alist))
! (alist (cond
! (all-win ; Try to restore all windows.
! (append return-to-alist nil)) ; Copy.
! (sel-old ; Only selected window.
! (list sel-old))))
! (old-window (if sel-old (car (cdr sel-old)))))
! (if all-win ; Follow chains of old-windows.
! (let ((c (length alist)) a)
! (while (and (> c 0) ; Safety if mutually refering windows.
! (or (not (window-live-p old-window))
! (eq buffer (window-buffer old-window)))
! (setq a (assq old-window alist)))
! (setq c (1- c))
! (setq old-window (car (cdr a))))
! (if (or (zerop c) (not (window-live-p old-window)))
! (setq old-window (selected-window)))))
! (unless view-no-disable-on-exit
! (view-mode-disable))
! (while alist ; Restore windows with info.
! (setq notlost nil)
! (when (and (window-live-p (setq window (car (car alist))))
(eq buffer (window-buffer window)))
! (let ((frame (window-frame window))
! (old-buf-info (cdr (cdr (car alist)))))
! (if all-win (select-window window))
! (cond
! ((and (consp old-buf-info) ; Case 3.
! (buffer-live-p (car old-buf-info)))
! (set-window-buffer window (car old-buf-info)) ; old-buf
! (set-window-start window (car (cdr old-buf-info)))
! (set-window-point window (car (cdr (cdr old-buf-info)))))
! ((eq old-buf-info 'quit-window)
! (quit-window)) ; Case 4.
! ((not (eq old-buf-info t)) nil) ; Not case 2, do nothing.
! ((not (one-window-p t)) (delete-window))
! ((not (eq frame (next-frame)))
! ;; Not the only frame, so can safely be removed.
! (if view-remove-frame-by-deleting
! (delete-frame frame)
! (setq notlost t) ; Keep the window. See below.
! (iconify-frame frame))))))
! ;; If a frame is removed by iconifying it, the window is not
! ;; really lost. In this case we keep the entry in
! ;; `view-return-to-alist' so that if the user deiconifies the
! ;; frame and then hits q, the frame is iconified again.
! (unless notlost
! (with-current-buffer buffer
(setq view-return-to-alist
! (delete (car alist) view-return-to-alist))))
! (setq alist (cdr alist)))
! (when (window-live-p old-window)
! ;; old-window is still alive => select it.
! (select-window old-window))
! (when exit-action
! (setq view-exit-action nil)
! (funcall exit-action buffer))
! (force-mode-line-update))))
\f
(defun View-exit ()
"Exit View mode but stay in current buffer."
^ permalink raw reply [flat|nested] 9+ messages in thread