[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 <mats.lidell(a)cag.se&gt; # 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 <matsl(a)xemacs.org&gt; * 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 <matsl(a)xemacs.org&gt; * 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 <matsl(a)xemacs.org&gt; + + * 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 <mike(a)xemacs.org&gt; * 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 <matsl(a)xemacs.org&gt; + + * automated/keymap-tests.el: Use + help-activate-function-or-scroll-up. + 2013-12-17 Aidan Kehoe <kehoea(a)parhasard.net&gt; * 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 _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches