comparison lisp/help.el @ 16391:5d64d742ccbb

(print-help-return-message): Use new functions `special-display-p' and `same-window-p' to determine which help message to print. (Also unquote lambda forms.)

16390:77051008303f

;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; This code implements GNU Emac's on-line help system, the one invoked by
;;`M-x help-for-help'.

;;; Code:

;; Get the macro make-help-screen when this is compiled,

  "Display or return message saying how to restore windows after help command.
Computes a message and applies the optional argument FUNCTION to it.
If FUNCTION is nil, applies `message' to it, thus printing it."
  (and (not (get-buffer-window standard-output))
       (let ((first-message
	      (cond ((or (member (buffer-name standard-output)
				 special-display-buffer-names)
			 (assoc (buffer-name standard-output)
				special-display-buffer-names)
			 (let (found
			       (tail special-display-regexps)
			       (name (buffer-name standard-output)))
			   (while (and tail (not found))
			     (if (or (and (consp (car tail))
					  (string-match (car (car tail)) name))
				     (and (stringp (car tail))
					  (string-match (car tail) name)))
				 (setq found t))
			     (setq tail (cdr tail)))
			   found))
		     ;; If the help output buffer is a special display buffer,
		     ;; don't say anything about how to get rid of it.
		     ;; First of all, the user will do that with the window
		     ;; manager, not with Emacs.
		     ;; Secondly, the buffer has not been displayed yet,
		     ;; so we don't know whether its frame will be selected.
		     ;; Even the message about scrolling the help
		     ;; might be wrong, but it seems worth showing it anyway.
		     nil)
		    ((not (one-window-p t))
		     "Type \\[switch-to-buffer-other-window] RET to restore the other window.")
		    (pop-up-windows
		     "Type \\[delete-other-windows] to remove help window.")

		       (substitute-command-keys first-message)
		     "")
		   (if first-message "  " "")
		   ;; If the help buffer will go in a separate frame,
		   ;; it's no use mentioning a command to scroll, so don't.
		   (if (or (member (buffer-name standard-output)
				   special-display-buffer-names)
			   (assoc (buffer-name standard-output)
				  special-display-buffer-names)
			   (memq t (mapcar '(lambda (elt)
					      (if (consp elt)
						  (setq elt (car elt)))
					      (string-match elt (buffer-name standard-output)))
					   special-display-regexps)))
		       nil
		     (if (or (member (buffer-name standard-output)
				     same-window-buffer-names)
			     (assoc (buffer-name standard-output)
				    same-window-buffer-names)
			     (memq t (mapcar '(lambda (elt)
						(if (consp elt)
						    (setq elt (car elt)))
						(string-match elt (buffer-name standard-output)))
					     same-window-regexps)))
			 ;; Say how to scroll this window.
			 (substitute-command-keys
			  "\\[scroll-up] to scroll the help.")
		       ;; Say how to scroll some other window.
		       (substitute-command-keys

		     nil nil
		     t))
  (let (result)
    (catch 'answer
      (mapcar
       '(lambda (dir)
	  (mapcar
	   '(lambda (suf)
	      (let ((try (expand-file-name (concat library suf) dir)))
		(and (file-readable-p try)
		     (null (file-directory-p try))
		     (progn
		       (setq result try)
		       (throw 'answer try)))))
	   (if nosuffix
	       '("")
	     (let ((basic '(".elc" ".el" ""))
		   (compressed '(".Z" ".gz" "")))
	       ;; If autocompression mode is on,
	       ;; consider all combinations of library suffixes
	       ;; and compression suffixes.
	       (if (rassq 'jka-compr-handler file-name-handler-alist)
		   (apply 'nconc
			  (mapcar '(lambda (compelt)
				     (mapcar '(lambda (baselt)
						(concat baselt compelt))
					     basic))
				  compressed))
		 basic)))))
       (or path load-path)))
    (and interactive-call
	 (if result
	     (message "Library is file %s" result)
	   (message "No library %s in search path" library)))

16391:5d64d742ccbb

;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; This code implements GNU Emacs' on-line help system, the one invoked by
;;`M-x help-for-help'.

;;; Code:

;; Get the macro make-help-screen when this is compiled,

  "Display or return message saying how to restore windows after help command.
Computes a message and applies the optional argument FUNCTION to it.
If FUNCTION is nil, applies `message' to it, thus printing it."
  (and (not (get-buffer-window standard-output))
       (let ((first-message
	      (cond ((special-display-p (buffer-name standard-output))
		     ;; If the help output buffer is a special display buffer,
		     ;; don't say anything about how to get rid of it.
		     ;; First of all, the user will do that with the window
		     ;; manager, not with Emacs.
		     ;; Secondly, the buffer has not been displayed yet,
		     ;; so we don't know whether its frame will be selected.
		     nil)
		    ((not (one-window-p t))
		     "Type \\[switch-to-buffer-other-window] RET to restore the other window.")
		    (pop-up-windows
		     "Type \\[delete-other-windows] to remove help window.")

		       (substitute-command-keys first-message)
		     "")
		   (if first-message "  " "")
		   ;; If the help buffer will go in a separate frame,
		   ;; it's no use mentioning a command to scroll, so don't.
		   (if (special-display-p (buffer-name standard-output))
		       nil
		     (if (same-window-p (buffer-name standard-output))
			 ;; Say how to scroll this window.
			 (substitute-command-keys
			  "\\[scroll-up] to scroll the help.")
		       ;; Say how to scroll some other window.
		       (substitute-command-keys

		     nil nil
		     t))
  (let (result)
    (catch 'answer
      (mapcar
       (lambda (dir)
	 (mapcar
	  (lambda (suf)
	    (let ((try (expand-file-name (concat library suf) dir)))
	      (and (file-readable-p try)
		   (null (file-directory-p try))
		   (progn
		     (setq result try)
		     (throw 'answer try)))))
	  (if nosuffix
	      '("")
	    (let ((basic '(".elc" ".el" ""))
		  (compressed '(".Z" ".gz" "")))
	      ;; If autocompression mode is on,
	      ;; consider all combinations of library suffixes
	      ;; and compression suffixes.
	      (if (rassq 'jka-compr-handler file-name-handler-alist)
		  (apply 'nconc
			 (mapcar (lambda (compelt)
				   (mapcar (lambda (baselt)
					     (concat baselt compelt))
					   basic))
				 compressed))
		basic)))))
       (or path load-path)))
    (and interactive-call
	 (if result
	     (message "Library is file %s" result)
	   (message "No library %s in search path" library)))