[COMMIT] Help buffer behaviour synced with GNU

APPROVE COMMIT

NOTE: This patch has been committed.

% hg export 5793:cf0201de66df
# HG changeset patch
# User Mats Lidell <[email protected]>
# Date 1398461896 -7200
#      Fri Apr 25 23:38:16 2014 +0200
# Node ID cf0201de66dfcbf2372fae706bff132bd4f0aef6
# Parent  8ef8d5e7c9202627f9bccbb0a09fd2042a08794a
Help buffer behaviour synced with GNU

lisp/ChangeLog:

2014-04-19  Mats Lidell  <[email protected]>

	* help.el: Sync from GNU - Link to customize if applicable and
	display version info. Other changes: Remove use of button-2.
	return and button-1 use activate-function. Move between
	activate-function-extents with tab.

tests/ChangeLog:

2014-04-19  Mats Lidell  <[email protected]>

	* automated/keymap-tests.el: Use
	help-activate-function-or-scroll-up.

diff -r 8ef8d5e7c920 -r cf0201de66df CHANGES-beta
--- a/CHANGES-beta	Fri Mar 28 12:48:12 2014 -0600
+++ b/CHANGES-beta	Fri Apr 25 23:38:16 2014 +0200
@@ -12,6 +12,7 @@
 -- Improve: Make #'byte-compile-if suppress spurious warnings from `(if (fboundp ...' or `(if (boundp ...' constructs (port of Dave Love patch to Emacs) -- Mike Sperber
 -- Improve: Silence warnings about throws out of #'post-command-hook' -- Mike Sperber
 -- New: Support bignums with MPIR -- Jerry James
+-- Improve: Help buffer behaviour synced with GNU -- Mats Lidell
 
 Build Infrastructure and Source Tree
 
diff -r 8ef8d5e7c920 -r cf0201de66df lisp/ChangeLog
--- a/lisp/ChangeLog	Fri Mar 28 12:48:12 2014 -0600
+++ b/lisp/ChangeLog	Fri Apr 25 23:38:16 2014 +0200
@@ -1,3 +1,10 @@
+2014-04-19  Mats Lidell  <[email protected]>
+
+	* help.el: Sync from GNU - Link to customize if applicable and
+	display version info. Other changes: Remove use of button-2.
+	return and button-1 use activate-function. Move between
+	activate-function-extents with tab.
+
 2014-01-27  Michael Sperber  <[email protected]>
 
 	* font-lock.el (font-lock-regexp-grouping-backslash,
diff -r 8ef8d5e7c920 -r cf0201de66df lisp/help.el
--- a/lisp/help.el	Fri Mar 28 12:48:12 2014 -0600
+++ b/lisp/help.el	Fri Apr 25 23:38:16 2014 +0200
@@ -1,6 +1,6 @@
 ;; help.el --- help commands for XEmacs.
 
-;; Copyright (C) 1985, 1986, 1992-4, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1992-4, 1997, 2014 Free Software Foundation, Inc.
 ;; Copyright (C) 2001, 2002, 2003, 2010 Ben Wing.
 
 ;; Maintainer: FSF
@@ -56,6 +56,9 @@
                    map)
   "Keymap for characters following the Help key.")
 
+(defvar help-mode-link-positions nil)
+(make-variable-buffer-local 'help-mode-link-positions)
+
 ;; global-map definitions moved to keydefs.el
 (fset 'help-command help-map)
 
@@ -142,6 +145,7 @@
 Entry to this mode runs the normal hook `help-mode-hook'.
 Commands:
 \\{help-mode-map}"
+  (help-mode-get-link-positions)
   )
 
 (define-key help-mode-map "q" 'help-mode-quit)
@@ -152,9 +156,9 @@
 (define-key help-mode-map "i" 'Info-elisp-ref)
 (define-key help-mode-map "c" 'customize-variable)
 (define-key help-mode-map [tab] 'help-next-symbol)
-(define-key help-mode-map [(shift tab)] 'help-prev-symbol)
-(define-key help-mode-map [return] 'help-find-source-or-scroll-up)
-(define-key help-mode-map [button2] 'help-mouse-find-source-or-track)
+(define-key help-mode-map [iso-left-tab] 'help-prev-symbol)
+(define-key help-mode-map [backtab] 'help-prev-symbol)
+(define-key help-mode-map [return] 'help-activate-function-or-scroll-up)
 (define-key help-mode-map "n" 'help-next-section)
 (define-key help-mode-map "p" 'help-prev-section)
 
@@ -185,14 +189,26 @@
       (describe-variable symb))))
 
 (defun help-next-symbol ()
-  "Move point to the next quoted symbol."
+  "Move point to the next link."
   (interactive)
-  (search-forward "`" nil t))
+  (let ((p (point))
+	(positions help-mode-link-positions)
+	(firstpos (car help-mode-link-positions)))
+    (while (and positions (>= p (car positions)))
+      (setq positions (cdr positions)))
+    (if (or positions firstpos)
+	(goto-char (or (car positions) firstpos)))))
 
 (defun help-prev-symbol ()
-  "Move point to the previous quoted symbol."
+  "Move point to the previous link."
   (interactive)
-  (search-backward "'" nil t))
+  (let* ((p (point))
+	(positions (reverse help-mode-link-positions))
+	(lastpos (car positions)))
+    (while (and positions (<= p (car positions)))
+      (setq positions (cdr positions)))
+    (if (or positions lastpos)
+	(goto-char (or (car positions) lastpos)))))
 
 (defun help-next-section ()
   "Move point to the next quoted symbol."
@@ -227,6 +243,16 @@
   (interactive)
   nil)
 
+(defun help-mode-get-link-positions ()
+  "Get the positions of the links in the help buffer"
+  (let ((el (extent-list nil (point-min) (point-max) nil 'activate-function))
+	(positions nil))
+    (while el
+      (setq positions (append positions (list (extent-start-position (car el)))))
+      (setq el (cdr el)))
+    (setq help-mode-link-positions positions)))
+    
+
 (define-obsolete-function-alias 'deprecated-help-command 'help-for-help)
 
 ;;(define-key global-map 'backspace 'deprecated-help-command)
@@ -1283,11 +1309,13 @@
   (let ((help-sticky-window
 	 ;; if we were called from a help buffer, make sure the new help
 	 ;; goes in the same window.
-	 (if (and (event-buffer ev)
+	 (if (and ev 
+		  (event-buffer ev)
 		  (symbol-value-in-buffer 'help-window-config
 					  (event-buffer ev)))
 	     (event-window ev)
-	   help-sticky-window)))
+	   (if ev help-sticky-window
+	     (get-buffer-window (current-buffer))))))
     (funcall fun (extent-property ex 'help-symbol))))
 
 (defun help-symbol-run-function (fun)
@@ -1445,7 +1473,8 @@
 				 standard-output))
 	    (set-extent-property e 'face 'hyper-apropos-hyperlink)
 	    (set-extent-property e 'mouse-face 'highlight)
-	    (set-extent-property e 'find-function-symbol function)))
+	    (set-extent-property e 'help-symbol function)
+	    (set-extent-property e 'activate-function  #'(lambda (ev ex) (help-symbol-run-function-1 ev ex 'find-function)))))
 	(princ "\"\n"))
     (if describe-function-show-arglist
 	(let ((arglist (function-arglist function)))
@@ -1633,6 +1662,30 @@
        (if type "an unknown type of built-in variable?"
 	 "a variable declared in Lisp")))))
 
+(defun describe-variable-custom-version-info (variable)
+  (let ((custom-version (get variable 'custom-version))
+	(cpv (get variable 'custom-package-version))
+	(output nil))
+    (if custom-version
+	(setq output
+	      (format "This variable was introduced, or its default value was changed, in\nversion %s of XEmacs.\n"
+		      custom-version))
+      (when cpv
+	(let* ((package (car-safe cpv))
+	       (version (if (listp (cdr-safe cpv))
+			    (car (cdr-safe cpv))
+			  (cdr-safe cpv)))
+	       (pkg-versions (assq package customize-package-emacs-version-alist))
+	       (emacsv (cdr (assoc version pkg-versions))))
+	  (if (and package version)
+	      (setq output
+		    (format (concat "This variable was introduced, or its default value was changed, in\nversion %s of the %s package"
+				    (if emacsv
+					(format " that is part of XEmacs %s" emacsv))
+				    ".\n")
+			    version package))))))
+    output))
+
 (defun describe-variable (variable)
   "Display the full documentation of VARIABLE (a symbol)."
   (interactive
@@ -1684,7 +1737,8 @@
 				      standard-output))
 		 (set-extent-property e 'face 'hyper-apropos-hyperlink)
 		 (set-extent-property e 'mouse-face 'highlight)
-		 (set-extent-property e 'find-variable-symbol variable))
+		 (set-extent-property e 'help-symbol variable)
+		 (set-extent-property e 'activate-function  #'(lambda (ev ex) (help-symbol-run-function-1 ev ex 'find-variable))))
 	       (princ"\"\n")))
 	 (princ "\nValue: ")
     	 (if (not (boundp variable))
@@ -1739,6 +1793,33 @@
 		 (frob-help-extents standard-output)
 		 (goto-char newp standard-output))
 	     (princ "not documented as a variable."))))
+       ;; Make a link to customize if this variable can be customized.
+       (when (custom-variable-p variable)
+	 (let ((customize-label "customize"))
+	   (terpri)
+	   (terpri)
+	   (princ (concat "You can " customize-label " this variable."))
+	   (with-current-buffer standard-output
+	     (save-excursion
+	       (re-search-backward
+		(concat "\\(" customize-label "\\)") nil t)
+	       (let ((opoint (point standard-output))
+		     e)
+		 (require 'hyper-apropos)
+		 ;; (princ variable)
+		 (re-search-forward (concat "\\(" customize-label "\\)") nil t)
+		 (setq e (make-extent opoint (point standard-output)
+				      standard-output))
+		 (set-extent-property e 'face 'hyper-apropos-hyperlink)
+		 (set-extent-property e 'mouse-face 'highlight)
+		 (set-extent-property e 'help-symbol variable)
+		 (set-extent-property e 'activate-function  #'(lambda (ev ex) (help-symbol-run-function-1 ev ex 'customize-variable)))))))
+	 ;; Note variable's version or package version
+	 (let ((output (describe-variable-custom-version-info variable)))
+	   (when output
+	     (terpri)
+	     (terpri)
+	     (princ output))))
        (terpri)))
    (format "variable `%s'" variable)))
 
@@ -1870,33 +1951,13 @@
 	(with-displaying-help-buffer
 	 (insert string)))))
 
-(defun help-find-source-or-scroll-up (&optional pos)
+(defun help-activate-function-or-scroll-up (&optional pos)
   "Follow any cross reference to source code; if none, scroll up.  "
   (interactive "d")
-  (let ((e (extent-at pos nil 'find-function-symbol)))
-    (if (and-fboundp 'find-function e)
-        (with-fboundp 'find-function
-          (find-function (extent-property e 'find-function-symbol)))
-      (setq e (extent-at pos nil 'find-variable-symbol))
-      (if (and-fboundp 'find-variable e)
-          (with-fboundp 'find-variable
-            (find-variable (extent-property e 'find-variable-symbol)))
-	(scroll-up 1)))))
-
-(defun help-mouse-find-source-or-track (event)
-  "Follow any cross reference to source code under the mouse; 
-if none, call mouse-track.  "
-  (interactive "e")
-  (mouse-set-point event)
-  (let ((e (extent-at (point) nil 'find-function-symbol)))
-    (if (and-fboundp 'find-function e)
-        (with-fboundp 'find-function
-          (find-function (extent-property e 'find-function-symbol)))
-      (setq e (extent-at (point) nil 'find-variable-symbol))
-      (if (and-fboundp 'find-variable e)
-          (with-fboundp 'find-variable
-            (find-variable (extent-property e 'find-variable-symbol)))
-	(mouse-track event)))))
+  (let ((e (extent-at pos nil 'activate-function)))
+    (if e
+	(funcall (extent-property e 'activate-function) nil e)
+      (scroll-up 1))))
 
 (define-minor-mode temp-buffer-resize-mode
   "Toggle the mode which makes windows smaller for temporary buffers.
diff -r 8ef8d5e7c920 -r cf0201de66df tests/ChangeLog
--- a/tests/ChangeLog	Fri Mar 28 12:48:12 2014 -0600
+++ b/tests/ChangeLog	Fri Apr 25 23:38:16 2014 +0200
@@ -1,3 +1,8 @@
+2014-04-19  Mats Lidell  <[email protected]>
+
+	* automated/keymap-tests.el: Use
+	help-activate-function-or-scroll-up.
+
 2013-12-17  Aidan Kehoe  <[email protected]>
 
 	* automated/lisp-tests.el:
diff -r 8ef8d5e7c920 -r cf0201de66df tests/automated/keymap-tests.el
--- a/tests/automated/keymap-tests.el	Fri Mar 28 12:48:12 2014 -0600
+++ b/tests/automated/keymap-tests.el	Fri Apr 25 23:38:16 2014 +0200
@@ -36,7 +36,7 @@
                             find-function-at-point Q help-mode-bury button2
                             help-mouse-find-source-or-track p
                             help-prev-section n help-next-section return
-                            help-find-source-or-scroll-up)
+                            help-activate-function-or-scroll-up)
         by #'cddr
         do (define-key map (vector keys) def))
   (loop for (keys def) on '(u view-scroll-some-lines-down % view-goto-percent

Done 23:45:26