commit/XEmacs: matsl: Help buffer behaviour synced with GNU

[email protected]
Newsgroups gmane.emacs.xemacs.patches
Message-ID <[email protected]>
1 new commit in XEmacs:

https://bitbucket.org/xemacs/xemacs/commits/cf0201de66df/
Changeset:   cf0201de66df
User:        matsl
Date:        2014-04-25 23:38:16
Summary:     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.
Affected #:  5 files

diff -r 8ef8d5e7c9202627f9bccbb0a09fd2042a08794a -r cf0201de66dfcbf2372fae706bff132bd4f0aef6 CHANGES-beta
--- a/CHANGES-beta
+++ b/CHANGES-beta
@@ -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 8ef8d5e7c9202627f9bccbb0a09fd2042a08794a -r cf0201de66dfcbf2372fae706bff132bd4f0aef6 lisp/ChangeLog
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -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 8ef8d5e7c9202627f9bccbb0a09fd2042a08794a -r cf0201de66dfcbf2372fae706bff132bd4f0aef6 lisp/help.el
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -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 8ef8d5e7c9202627f9bccbb0a09fd2042a08794a -r cf0201de66dfcbf2372fae706bff132bd4f0aef6 tests/ChangeLog
--- a/tests/ChangeLog
+++ b/tests/ChangeLog
@@ -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 8ef8d5e7c9202627f9bccbb0a09fd2042a08794a -r cf0201de66dfcbf2372fae706bff132bd4f0aef6 tests/automated/keymap-tests.el
--- a/tests/automated/keymap-tests.el
+++ b/tests/automated/keymap-tests.el
@@ -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

Repository URL: https://bitbucket.org/xemacs/xemacs/

--

This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.