X-Git-Url: http://cgit.sxemacs.org/?p=sxemacs;a=blobdiff_plain;f=lisp%2Fhelp.el;h=93564f5d315053ab1593471f2393b8c71a3efdff;hp=bdb6b3117d07a817a7dc8e534c82359c5aa9b272;hb=c06d9ce5508b3ccad7c563404c5fd72ed5fc2522;hpb=c879e5b17b3d5fef34ab58fc66e1cbb4269e5bb4

diff --git a/lisp/help.el b/lisp/help.el
index bdb6b31..93564f5 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -38,9 +38,12 @@
 
 ;; Get the macro make-help-screen when this is compiled,
 ;; or run interpreted, but not when the compiled code is loaded.
-(eval-when-compile (require 'help-macro))
+(eval-when-compile
+  (require 'help-macro)
+  (globally-declare-fboundp
+   '(find-function find-variable view-scroll-lines-up)))
 
-(require 'loadhist) ;; For symbol-file. 
+(require 'loadhist) ;; For symbol-file.
 
 (defgroup help nil
   "Support for on-line help systems."
@@ -51,10 +54,10 @@
   :group 'help)
 
 (defvar help-map (let ((map (make-sparse-keymap)))
-                   (set-keymap-name map 'help-map)
-                   (set-keymap-prompt
+		   (set-keymap-name map 'help-map)
+		   (set-keymap-prompt
 		    map (gettext "(Type ? for further options)"))
-                   map)
+		   map)
   "Keymap for characters following the Help key.")
 
 ;; global-map definitions moved to keydefs.el
@@ -329,7 +332,7 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
 	defn menup)
     (setq defn (key-or-menu-binding key 'menup))
     (if (or (null defn) (integerp defn))
-        (princ (format "%s is undefined" (key-description key)))
+	(princ (format "%s is undefined" (key-description key)))
       ;; If it's a keyboard macro which trivially invokes another command,
       ;; document that instead.
       (if (or (stringp defn) (vectorp defn))
@@ -370,14 +373,14 @@ If FUNCTION is nil, applies `message' to it, thus printing it."
        (funcall
 	(or function 'message)
 	(concat
-         (substitute-command-keys
-          (if (one-window-p t)
-              (if pop-up-windows
-                  (gettext "Type \\[delete-other-windows] to remove help window.")
-                (gettext "Type \\[switch-to-buffer] RET to remove help window."))
+	 (substitute-command-keys
+	  (if (one-window-p t)
+	      (if pop-up-windows
+		  (gettext "Type \\[delete-other-windows] to remove help window.")
+		(gettext "Type \\[switch-to-buffer] RET to remove help window."))
    (gettext "Type \\[switch-to-buffer-other-window] RET to restore the other window.")))
-         (substitute-command-keys
-          (gettext "  \\[scroll-other-window] to scroll the help."))))))
+	 (substitute-command-keys
+	  (gettext "  \\[scroll-other-window] to scroll the help."))))))
 
 (defcustom help-selects-help-window t
   "*If nil, use the \"old Emacs\" behavior for Help buffers.
@@ -404,22 +407,22 @@ zero or nil, only one help buffer, \"*Help*\" is ever used."
   (setq help-buffer-list (remove newbuf help-buffer-list))
   ;; maybe kill excess help buffers
   (if (and (integerp help-max-help-buffers)
-           (> (length help-buffer-list) help-max-help-buffers))
+	   (> (length help-buffer-list) help-max-help-buffers))
       (let ((keep-list nil)
-            (num-kill (- (length help-buffer-list)
-                         help-max-help-buffers)))
-        (while help-buffer-list
-          (let ((buf (car help-buffer-list)))
-            (if (and (or (equal buf newbuf) (get-buffer buf))
-                     (string-match "^*Help" buf)
-                     (save-excursion (set-buffer buf)
-                                     (eq major-mode 'help-mode)))
-                (if (and (>= num-kill (length help-buffer-list))
-                         (not (get-buffer-window buf t t)))
-                    (kill-buffer buf)
-                  (setq keep-list (cons buf keep-list)))))
-          (setq help-buffer-list (cdr help-buffer-list)))
-        (setq help-buffer-list (nreverse keep-list))))
+	    (num-kill (- (length help-buffer-list)
+			 help-max-help-buffers)))
+	(while help-buffer-list
+	  (let ((buf (car help-buffer-list)))
+	    (if (and (or (equal buf newbuf) (get-buffer buf))
+		     (string-match "^*Help" buf)
+		     (save-excursion (set-buffer buf)
+				     (eq major-mode 'help-mode)))
+		(if (and (>= num-kill (length help-buffer-list))
+			 (not (get-buffer-window buf t t)))
+		    (kill-buffer buf)
+		  (setq keep-list (cons buf keep-list)))))
+	  (setq help-buffer-list (cdr help-buffer-list)))
+	(setq help-buffer-list (nreverse keep-list))))
   ;; push new buffer
   (setq help-buffer-list (cons newbuf help-buffer-list)))
 
@@ -430,8 +433,8 @@ You should never set this directory, only let-bind it.")
 (defun help-buffer-name (name)
   "Return a name for a Help buffer using string NAME for context."
   (if (and (integerp help-max-help-buffers)
-           (> help-max-help-buffers 0)
-           (stringp name))
+	   (> help-max-help-buffers 0)
+	   (stringp name))
       (if help-buffer-prefix-string
 	  (format "*%s: %s*" help-buffer-prefix-string name)
 	(format "*%s*" name))
@@ -522,7 +525,7 @@ When called interactively, KEY may also be a menu selection."
   (let ((defn (key-or-menu-binding key))
 	(key-string (key-description key)))
     (if (or (null defn) (integerp defn))
-        (message "%s is undefined" key-string)
+	(message "%s is undefined" key-string)
       (with-displaying-help-buffer
        (lambda ()
 	 (princ key-string)
@@ -653,15 +656,15 @@ is non-nil then only the mouse bindings are displayed."
 
 (defun describe-bindings-1 (&optional prefix mouse-only-p)
   (let ((heading (if mouse-only-p
-            (gettext "button          binding\n------          -------\n")
-            (gettext "key             binding\n---             -------\n")))
-        (buffer (current-buffer))
-        (minor minor-mode-map-alist)
+	    (gettext "button          binding\n------          -------\n")
+	    (gettext "key             binding\n---             -------\n")))
+	(buffer (current-buffer))
+	(minor minor-mode-map-alist)
 	(extent-maps (mapcar-extents
 		      'extent-keymap
 		      nil (current-buffer) (point) (point) nil 'keymap))
-        (local (current-local-map))
-        (shadow '()))
+	(local (current-local-map))
+	(shadow '()))
     (set-buffer standard-output)
     (while extent-maps
       (insert "Bindings for Text Region:\n"
@@ -673,25 +676,25 @@ is non-nil then only the mouse bindings are displayed."
 	     extent-maps (cdr extent-maps)))
     (while minor
       (let ((sym (car (car minor)))
-            (map (cdr (car minor))))
-        (if (symbol-value-in-buffer sym buffer nil)
-            (progn
-              (insert (format "Minor Mode Bindings for `%s':\n"
-                              sym)
-                      heading)
-              (describe-bindings-internal map nil shadow prefix mouse-only-p)
-              (insert "\n")
-              (setq shadow (cons map shadow))))
-        (setq minor (cdr minor))))
+	    (map (cdr (car minor))))
+	(if (symbol-value-in-buffer sym buffer nil)
+	    (progn
+	      (insert (format "Minor Mode Bindings for `%s':\n"
+			      sym)
+		      heading)
+	      (describe-bindings-internal map nil shadow prefix mouse-only-p)
+	      (insert "\n")
+	      (setq shadow (cons map shadow))))
+	(setq minor (cdr minor))))
     (if local
-        (progn
-          (insert "Local Bindings:\n" heading)
-          (describe-bindings-internal local nil shadow prefix mouse-only-p)
-          (insert "\n")
-          (setq shadow (cons local shadow))))
+	(progn
+	  (insert "Local Bindings:\n" heading)
+	  (describe-bindings-internal local nil shadow prefix mouse-only-p)
+	  (insert "\n")
+	  (setq shadow (cons local shadow))))
     (insert "Global Bindings:\n" heading)
     (describe-bindings-internal (current-global-map)
-                                nil shadow prefix mouse-only-p)
+				nil shadow prefix mouse-only-p)
     (when (and prefix function-key-map (not mouse-only-p))
       (insert "\nFunction key map translations:\n" heading)
       (describe-bindings-internal function-key-map nil nil
@@ -746,7 +749,7 @@ of the key sequence that ran this command."
   "Go to the SXEmacs World Wide Web page."
   (interactive)
   (if-fboundp 'browse-url
-      (browse-url "http://www.sxemacs.org/")
+      (browse-url "https://www.sxemacs.org/")
     (error "sxemacs-www-page requires browse-url")))
 
 (defalias 'xemacs-www-page 'sxemacs-www-page)
@@ -755,7 +758,7 @@ of the key sequence that ran this command."
   "View the latest and greatest SXEmacs FAQ using the World Wide Web."
   (interactive)
   (if-fboundp 'browse-url
-      (browse-url "http://www.sxemacs.org/faq/index.html")
+      (browse-url "https://www.sxemacs.org/faq/index.html")
     (error "sxemacs-www-faq requires browse-url")))
 
 (defalias 'xemacs-www-faq 'sxemacs-www-faq)
@@ -838,13 +841,13 @@ The number of messages shown is controlled by `view-lossage-message-count'."
 \(Use SPC or DEL to scroll through this text.  Type \\<help-map>\\[help-quit] to exit the Help command.)
 
 \\[hyper-apropos]	Type a substring; it shows a hypertext list of
-        functions and variables that contain that substring.
+	functions and variables that contain that substring.
 	See also the `apropos' command.
 \\[command-apropos]	Type a substring; it shows a list of commands
-        (interactively callable functions) that contain that substring.
+	(interactively callable functions) that contain that substring.
 \\[describe-bindings]	Table of all key bindings.
 \\[describe-key-briefly]	Type a command key sequence;
-        it displays the function name that sequence runs.
+	it displays the function name that sequence runs.
 \\[customize]	Customize Emacs options.
 \\[Info-goto-emacs-command-node]	Type a function name; it displays the Info node for that command.
 \\[describe-function]	Type a function name; it shows its documentation.
@@ -854,9 +857,9 @@ The number of messages shown is controlled by `view-lossage-message-count'."
 \\[info]	Info documentation reader.
 \\[Info-query]	Type an Info file name; it displays it in Info reader.
 \\[describe-key]	Type a command key sequence;
-        it displays the documentation for the command bound to that key.
+	it displays the documentation for the command bound to that key.
 \\[Info-goto-emacs-key-command-node]	Type a command key sequence;
-        it displays the Info node for the command bound to that key.
+	it displays the Info node for the command bound to that key.
 \\[view-lossage]	Recent input keystrokes and minibuffer messages.
 \\[describe-mode]	Documentation of current major and minor modes.
 \\[view-emacs-news]	News of recent SXEmacs changes.
@@ -969,13 +972,13 @@ When run interactively, it defaults to any function found by
 `function-at-point'."
   (interactive
     (let* ((fn (function-at-point))
-           (val (let ((enable-recursive-minibuffers t))
-                  (completing-read
-                    (if fn
-                        (format (gettext "Describe function (default %s): ")
+	   (val (let ((enable-recursive-minibuffers t))
+		  (completing-read
+		    (if fn
+			(format (gettext "Describe function (default %s): ")
 				fn)
-                        (gettext "Describe function: "))
-                    obarray 'fboundp t nil 'function-history
+			(gettext "Describe function: "))
+		    obarray 'fboundp t nil 'function-history
 		    (symbol-name fn)))))
       (list (intern val))))
   (with-displaying-help-buffer
@@ -1062,15 +1065,15 @@ arguments in the standard Lisp style."
 			 ((equal args "") nil)
 			 (args))))
 		(t t)))
-         (print-gensym nil))
+	 (print-gensym nil))
     (cond ((listp arglist)
 	   (prin1-to-string
 	    (cons function (loop
-                             for arg in arglist
-                             collect (if (memq arg '(&optional &rest))
-                                         arg
-                                       (make-symbol (upcase (symbol-name
-                                                             arg))))))
+			     for arg in arglist
+			     collect (if (memq arg '(&optional &rest))
+					 arg
+				       (make-symbol (upcase (symbol-name
+							     arg))))))
 	    t))
 	  ((stringp arglist)
 	   (format "(%s %s)" function arglist)))))
@@ -1085,7 +1088,7 @@ part of the documentation of internal subroutines."
 	       (void-function "(alias for undefined function)")
 	       (error "(unexpected error from `documention')"))))
     (when (and strip-arglist
-               (string-match "[\n\t ]*\narguments: ?(\\([^)]*\\))\n?\\'" doc))
+	       (string-match "[\n\t ]*\narguments: ?(\\([^)]*\\))\n?\\'" doc))
       (setq doc (substring doc 0 (match-beginning 0)))
       (and (zerop (length doc)) (setq doc (gettext "not documented"))))
     doc))
@@ -1258,29 +1261,29 @@ part of the documentation of internal subroutines."
 					   (an-p "an ")
 					   (t "a "))
 				     "%s"
-                                     (cond
-                                      ((eq 'neither macro-p)
-                                       "")
-                                      (macro-p " macro")
-                                      (t " function"))))
+				     (cond
+				      ((eq 'neither macro-p)
+				       "")
+				      (macro-p " macro")
+				      (t " function"))))
 			   string)))))
       (cond ((or (stringp def) (vectorp def))
-             (princ "a keyboard macro.")
+	     (princ "a keyboard macro.")
 	     (setq kbd-macro-p t))
-            ((special-form-p fndef)
-             (funcall int "built-in special form" nil 'neither))
-            ((subrp fndef)
-             (funcall int "built-in" nil macrop))
-            ((compiled-function-p fndef)
-             (funcall int "compiled Lisp" nil macrop))
-            ((eq (car-safe fndef) 'lambda)
-             (funcall int "Lisp" nil macrop))
-            ((eq (car-safe def) 'autoload)
+	    ((special-form-p fndef)
+	     (funcall int "built-in special form" nil 'neither))
+	    ((subrp fndef)
+	     (funcall int "built-in" nil macrop))
+	    ((compiled-function-p fndef)
+	     (funcall int "compiled Lisp" nil macrop))
+	    ((eq (car-safe fndef) 'lambda)
+	     (funcall int "Lisp" nil macrop))
+	    ((eq (car-safe def) 'autoload)
 	     (funcall int "autoloaded Lisp" t (elt def 4)))
 	    ((and (symbolp def) (not (fboundp def)))
 	     (princ "a symbol with a void (unbound) function definition."))
-            (t
-             nil)))
+	    (t
+	     nil)))
     (princ "\n")
     (or file-name
 	(setq file-name (symbol-file function 'defun)))
@@ -1290,7 +1293,7 @@ part of the documentation of internal subroutines."
 	    (princ file-name)
 	  (let ((opoint (point standard-output))
 		e)
-            (require 'hyper-apropos)
+	    (require 'hyper-apropos)
 	    (princ file-name)
 	    (setq e (make-extent opoint (point standard-output)
 				 standard-output))
@@ -1345,48 +1348,48 @@ part of the documentation of internal subroutines."
 		 (princ "\nInvoked with:\n")
 		 (let ((global-binding
 			(where-is-internal function global-map))
-		       (global-tty-binding 
+		       (global-tty-binding
 			(where-is-internal function global-tty-map))
-		       (global-window-system-binding 
+		       (global-window-system-binding
 			(where-is-internal function global-window-system-map)))
-                   (if (or global-binding global-tty-binding
-                           global-window-system-binding)
-                       (if (and (equal global-binding
-                                       global-tty-binding)
-                                (equal global-binding
-                                       global-window-system-binding))
-                           (princ
-                            (substitute-command-keys
-                             (format "\n\\[%s]" function)))
-                         (when (and global-window-system-binding
-                                    (not (equal global-window-system-binding
-                                                global-binding)))
-                           (princ 
-                            (format 
-                             "\n%s\n        -- under window systems\n"
-                             (mapconcat #'key-description
-                                        global-window-system-binding
-                                        ", "))))
-                         (when (and global-tty-binding
-                                    (not (equal global-tty-binding
-                                                global-binding)))
-                           (princ 
-                            (format 
-                             "\n%s\n        -- under TTYs\n"
-                             (mapconcat #'key-description
-                                        global-tty-binding
-                                        ", "))))
-                         (when global-binding
-                           (princ 
-                            (format 
-                             "\n%s\n        -- generally (that is, unless\
+		   (if (or global-binding global-tty-binding
+			   global-window-system-binding)
+		       (if (and (equal global-binding
+				       global-tty-binding)
+				(equal global-binding
+				       global-window-system-binding))
+			   (princ
+			    (substitute-command-keys
+			     (format "\n\\[%s]" function)))
+			 (when (and global-window-system-binding
+				    (not (equal global-window-system-binding
+						global-binding)))
+			   (princ
+			    (format
+			     "\n%s\n        -- under window systems\n"
+			     (mapconcat #'key-description
+					global-window-system-binding
+					", "))))
+			 (when (and global-tty-binding
+				    (not (equal global-tty-binding
+						global-binding)))
+			   (princ
+			    (format
+			     "\n%s\n        -- under TTYs\n"
+			     (mapconcat #'key-description
+					global-tty-binding
+					", "))))
+			 (when global-binding
+			   (princ
+			    (format
+			     "\n%s\n        -- generally (that is, unless\
  overridden by TTY- or
-           window-system-specific mappings)\n"
-                             (mapconcat #'key-description
-                                        global-binding
-                                        ", ")))))
-                     (princ (substitute-command-keys
-                             (format "\n\\[%s]" function))))))))))))
+	   window-system-specific mappings)\n"
+			     (mapconcat #'key-description
+					global-binding
+					", ")))))
+		     (princ (substitute-command-keys
+			     (format "\n\\[%s]" function))))))))))))
 
 
 
@@ -1476,12 +1479,12 @@ there is no variable around that point, nil is returned."
   "Display the full documentation of VARIABLE (a symbol)."
   (interactive
    (let* ((v (variable-at-point))
-          (val (let ((enable-recursive-minibuffers t))
-                 (completing-read
-                   (if v
-                       (format "Describe variable (default %s): " v)
-                       (gettext "Describe variable: "))
-                   obarray 'boundp t nil 'variable-history
+	  (val (let ((enable-recursive-minibuffers t))
+		 (completing-read
+		   (if v
+		       (format "Describe variable (default %s): " v)
+		       (gettext "Describe variable: "))
+		   obarray 'boundp t nil 'variable-history
 		   (symbol-name v)))))
      (list (intern val))))
   (with-displaying-help-buffer
@@ -1526,7 +1529,7 @@ there is no variable around that point, nil is returned."
 		 (set-extent-property e 'find-variable-symbol variable))
 	       (princ"\"\n")))
 	 (princ "\nValue: ")
-    	 (if (not (boundp variable))
+	 (if (not (boundp variable))
 	     (Help-princ-face "void\n" 'hyper-apropos-documentation)
 	   (Help-prin1-face (symbol-value variable)
 			    'hyper-apropos-documentation)
@@ -1603,7 +1606,7 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
      (setq val (read-command
 		(if fn (format "Where is command (default %s): " fn)
 		  "Where is command: ")
-                (and fn (symbol-name fn))))
+		(and fn (symbol-name fn))))
      (list (if (equal (symbol-name val) "")
 	       fn val)
 	   current-prefix-arg)))
@@ -1717,12 +1720,12 @@ after the listing is made.)"
     (if e
 	(find-function (extent-property e 'find-function-symbol))
       (setq e (extent-at pos nil 'find-variable-symbol))
-      (if e 
+      (if e
 	  (find-variable (extent-property e 'find-variable-symbol))
 	(view-scroll-lines-up 1)))))
 
 (defun help-mouse-find-source-or-track (event)
-  "Follow any cross reference to source code under the mouse; 
+  "Follow any cross reference to source code under the mouse;
 if none, call mouse-track.  "
   (interactive "e")
   (mouse-set-point event)
@@ -1730,7 +1733,7 @@ if none, call mouse-track.  "
     (if e
 	(find-function (extent-property e 'find-function-symbol))
       (setq e (extent-at (point) nil 'find-variable-symbol))
-      (if e 
+      (if e
 	  (find-variable (extent-property e 'find-variable-symbol))
 	(view-scroll-lines-up 1)))))