xemacs-beta: lisp/prim/help.el comparison

comparison lisp/prim/help.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30

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

comparison

equal deleted inserted replaced

-:804d1389bcd6
+:131b0175ea99
 ;; 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,
+;; Free Software Foundation, 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 ;;; Synched up with: FSF 19.30.
 ;;; Commentary:
 ;; global-map definitions moved to keydefs.el
 (fset 'help-command help-map)
 (let ((ch help-char))
-(if (integerp ch)
+(if (or (characterp ch) (integerp ch))
 (setq ch (char-to-string ch)))
 (define-key help-map ch 'help-for-help))
 (define-key help-map "?" 'help-for-help)
 (define-key help-map 'help 'help-for-help)
 (define-key help-map "\C-w" 'describe-no-warranty)
 (define-key help-map "a" 'hyper-apropos) ; 'command-apropos in FSFmacs
 (define-key help-map "A" 'command-apropos)
 (define-key help-map "b" 'describe-bindings)
-(define-key help-map "B" 'describe-beta)
 (define-key help-map "\C-p" 'describe-pointer)
 (define-key help-map "c" 'describe-key-briefly)
 (define-key help-map "k" 'describe-key)
 )
 (define-key help-mode-map "q" 'help-mode-quit)
 (defun help-mode-quit ()
-"Exits from help mode, possibly restoring the previous window configuration."
+"Exits from help mode, possiblely restoring the previous window configuration."
 (interactive)
-(cond ((frame-property (selected-frame) 'help-window-config)
+(cond ((local-variable-p 'help-window-config (current-buffer))
-	   (set-window-configuration
+(let ((config help-window-config))
-	    (frame-property (selected-frame) 'help-window-config))
+	   (kill-local-variable 'help-window-config)
-	   (set-frame-property  (selected-frame) 'help-window-config nil))
+	   (set-window-configuration config)))
 ((one-window-p)
 	 (bury-buffer))
 (t
 (delete-window))))
 (defvar help-selects-help-window t
 "*If nil, use the \"old Emacs\" behavior for Help buffers.
 This just displays the buffer in another window, rather than selecting
 the window.")
+(defvar help-window-config nil)
 ;; Use this function for displaying help when C-h something is pressed
 ;; or in similar situations.  Do *not* use it when you are displaying
 ;; a help message and then prompting for input in the minibuffer --
 ;; this macro usually selects the help buffer, which is not what you
 ;; want in those situations.
 ;;; ### Should really be a macro (as suggested above) to eliminate the
 ;;; requirement of caller to code a lambda form in THUNK -- mrb
 (defun with-displaying-help-buffer (thunk)
 (let ((winconfig (current-window-configuration))
-(was-one-window (one-window-p))
+(was-one-window (one-window-p)))
-	(help-not-visible
-	 (not (and (windows-of-buffer "*Help*") ;shortcut
-		   (member (selected-frame)
-			   (mapcar 'window-frame
-				   (windows-of-buffer "*Help*")))))))
 (prog1 (with-output-to-temp-buffer "*Help*"
 (prog1 (funcall thunk)
 (save-excursion
 (set-buffer standard-output)
 (help-mode))))
 (let ((helpwin (get-buffer-window "*Help*")))
 (if helpwin
 (progn
 (save-excursion
 (set-buffer (window-buffer helpwin))
-		;;If the *Help* buffer is already displayed on this
+(set (make-local-variable 'help-window-config) winconfig))
-		;; frame, don't override the previous configuration
-		(if help-not-visible
-		    (set-frame-property (selected-frame)
-					'help-window-config winconfig)))
 (if help-selects-help-window
 (select-window helpwin))
 (cond ((eq helpwin (selected-window))
 (message
 (substitute-command-keys "Type \\[help-mode-quit] to remove help window, \\[scroll-up] to scroll the help.")))
 (substitute-command-keys "Type \\[switch-to-buffer-other-window] to restore the other window, \\[scroll-other-window] to scroll the help."))))))))))
 (defun describe-key (key)
 "Display documentation of the function invoked by KEY.
 KEY is a string, or vector of events.
-When called interactively, KEY may also be a menu selection."
+When called interactvely, KEY may also be a menu selection."
 (interactive "kDescribe key: ")
 (let ((defn (key-or-menu-binding key)))
 (if (or (null defn) (integerp defn))
 (message "%s is undefined" (key-description key))
 (with-displaying-help-buffer
 (defun describe-distribution ()
 "Display info on how to obtain the latest version of XEmacs."
 (interactive)
 (find-file-read-only
 (expand-file-name "DISTRIB" data-directory)))
-(defun describe-beta ()
-"Display info on how to deal with Beta versions of XEmacs."
-(interactive)
-(find-file-read-only
-(expand-file-name "BETA" data-directory))
-(goto-char (point-min)))
 (defun describe-copying ()
 "Display info on how you may redistribute copies of XEmacs."
 (interactive)
 (find-file-read-only
 		     (eq char ??)
 		     (eq 'help-command (key-binding event))
 		     (eq char ? )
 		     (eq 'scroll-up (key-binding event))
 		     (eq char ?\177)
-		     (and (not (eq char ?b))
+		     (eq 'scroll-down (key-binding event)))
-			  (eq 'scroll-down (key-binding event))))
 	    (if (or (eq char ? )
 		    (eq 'scroll-up (key-binding event)))
 		(scroll-up))
 	    (if (or (eq char ?\177)
-		    (and (not (eq char ?b))
+		    (eq 'scroll-down (key-binding event)))
-			 (eq 'scroll-down (key-binding event))))
 		(scroll-down))
 	    ;; write this way for I18N3 snarfing
 	    (if (pos-visible-in-window-p (point-max))
 		(message "A B C F I K L M N P S T V W C-c C-d C-n C-w C-i C-k C-f: ")
 	      (message "A B C F I K L M N P S T V W C-c C-d C-n C-w C-i C-k C-f or Space to scroll: "))
 	(format "Obsolete; %s"
 		(if (stringp (car obsolete))
 		    (car obsolete)
 		  (format "use `%s' instead." (car obsolete)))))))
-(defun function-compatible-p (function)
-"Return non-nil if FUNCTION is present for Emacs compatibility."
-(not (null (get function 'byte-compatible-info))))
-(defun function-compatibility-doc (function)
-"If FUNCTION is Emacs compatible, return a string describing this."
-(let ((compatible (get function 'byte-compatible-info)))
-(if compatible
-	(format "Emacs Compatible; %s"
-		(if (stringp (car compatible))
-		    (car compatible)
-		  (format "use `%s' instead." (car compatible)))))))
 ;Here are all the possibilities below spelled out, for the benefit
 ;of the I18N3 snarfer.
 ;
 ;(gettext "a built-in function")
 ;(gettext "an interactive built-in function")
 (princ ": " stream)
 (let* ((def function)
 	 file-name
 (doc (or (documentation function)
 (gettext "not documented")))
-	 aliases home kbd-macro-p fndef macrop)
+	 aliases kbd-macro-p fndef macrop)
 (while (symbolp def)
 (or (eq def function)
 	  (if aliases
 	      ;; I18N3 Need gettext due to concat
 	      (setq aliases (concat aliases
 				    (format "\n     which is an alias for %s, "
 					    (symbol-name def))))
 	    (setq aliases (format "an alias for %s, " (symbol-name def)))))
 (setq def (symbol-function def)))
-(if (compiled-function-p def)
-	(setq home (compiled-function-annotation def)))
 (if (eq 'macro (car-safe def))
 	(setq fndef (cdr def)
 	      macrop t)
 (setq fndef def))
 (if describe-function-show-arglist
 nil)))
 (or file-name
 	(setq file-name (describe-function-find-file function)))
 (if file-name
 	(princ (format ".\n  -- loads from \"%s\"" file-name) stream))
-(if home
+(princ ".")
-	(princ (format ".\n  -- loaded from %s" home)))
+(terpri)
-(princ "." stream)
-(terpri stream)
 (cond (kbd-macro-p
 	   (princ "These characters are executed:\n\n\t" stream)
 	   (princ (key-description def) stream)
 	   (cond ((setq def (key-binding def))
 		  (princ (format "\n\nwhich executes the command %s.\n\n" def) stream)
 	  (t
 	   ;; tell the user about obsoleteness.
 	   ;; If the function is obsolete and is aliased, don't
 	   ;; even bother to report the documentation, as a further
 	   ;; encouragement to use the new function.
-	   (let ((obsolete (function-obsoleteness-doc function))
+	   (let ((obsolete (function-obsoleteness-doc function)))
-		 (compatible (function-compatibility-doc function)))
 	     (if obsolete
 		 (progn
 		   (princ obsolete stream)
-		   (terpri stream)
-		   (terpri stream)))
-	     (if compatible
-		 (progn
-		   (princ compatible stream)
 		   (terpri stream)
 		   (terpri stream)))
 	     (if (not (and obsolete aliases))
 		 (progn
 		   (princ doc stream)
 		   (or (eq ?\n (aref doc (1- (length doc))))
-		       (terpri stream)))))))))
+		       (terpri)))))))))
 (defun describe-function-arglist (function)
 (interactive (list (or (function-called-at-point)
 			 (error "no function call at point"))))
 (if obsolete
 	(format "Obsolete; %s"
 		(if (stringp obsolete)
 		    obsolete
 		  (format "use `%s' instead." obsolete))))))
-(defun variable-compatible-p (variable)
-"Return non-nil if VARIABLE is Emacs compatible."
-(not (null (get variable 'byte-compatible-variable))))
-(defun variable-compatibility-doc (variable)
-"If VARIABLE is Emacs compatible, return a string describing this."
-(let ((compatible (get variable 'byte-compatible-variable)))
-(if compatible
-	(format "Emacs Compatible; %s"
-		(if (stringp compatible)
-		    compatible
-		  (format "use `%s' instead." compatible))))))
 (defun built-in-variable-doc (variable)
 "Return a string describing whether VARIABLE is built-in."
 (let ((type (built-in-variable-type variable)))
 (cond ((eq type 'integer) "a built-in integer variable")
 		(terpri))))
 (terpri)
 (princ "Documentation:")
 (terpri)
 (let ((doc (documentation-property variable 'variable-documentation))
-	     (obsolete (variable-obsoleteness-doc origvar))
+	     (obsolete (variable-obsoleteness-doc origvar)))
-	     (compatible (variable-compatibility-doc origvar)))
 	 (if obsolete
 	     (progn
 	       (princ obsolete)
-	       (terpri)
-	       (terpri)))
-	 (if compatible
-	     (progn
-	       (princ compatible)
 	       (terpri)
 	       (terpri)))
 	 ;; don't bother to print anything if variable is obsolete and aliased.
 	 (if (or (not obsolete) (not aliases))
 	     (if doc
 (< (length x) (length y))))
 ", "))
 (message "%s is not on any keys" definition)))
 nil)
-;; Synched with Emacs 19.35
+(defun locate-library (library &optional nosuffix)
-(defun locate-library (library &optional nosuffix path interactive-call)
+"Show the full path name of XEmacs library LIBRARY.
-"Show the precise file name of Emacs library LIBRARY.
 This command searches the directories in `load-path' like `M-x load-library'
 to find the file that `M-x load-library RET LIBRARY RET' would load.
 Optional second arg NOSUFFIX non-nil means don't add suffixes `.elc' or `.el'
-to the specified name LIBRARY.
+to the specified name LIBRARY (a la calling `load' instead of `load-library')."
+(interactive "sLocate library: \nP")
-If the optional third arg PATH is specified, that list of directories
+;; Let's accept both symbols and strings, since they're often equivalent
-is used instead of `load-path'."
+(when (symbolp library)
-(interactive (list (read-string "Locate library: ")
+(setq library (symbol-name library)))
-nil nil
+;; XEmacs: We have the nifty `locate-file' so we use it.
-t))
+(let ((file (locate-file library load-path (if nosuffix nil ".elc:.el:"))))
-(let (result)
+(if file
-(catch 'answer
+	(message "Library is file %s" file)
-(mapcar
+(message "No library %s in search path" library))
-(lambda (dir)
+file))
-(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)))
-result))
 ;; Functions ported from C into Lisp in XEmacs
 (defun describe-syntax ()
 "Describe the syntax specifications in the syntax table.

Mercurial > hg > xemacs-beta

comparison lisp/prim/help.el @ 70:131b0175ea99 r20-0b30