lisp/help-at-pt.el

   1 ;;; help-at-pt.el --- local help through the keyboard
   2
   3 ;; Copyright (C) 2003-2017 Free Software Foundation, Inc.
   4
   5 ;; Author: Luc Teirlinck <teirllm@auburn.edu>
   6 ;; Keywords: help
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;; This file contains functionality to make the help provided by the
  26 ;; help-echo text or overlay property available to the keyboard user.
  27 ;; It also supports a more keyboard oriented alternative to
  28 ;; `help-echo', namely a new text or overlay property `kbd-help'.
  29 ;;
  30 ;; It provides facilities to access the local help available at point
  31 ;; either on demand, using the command `display-local-help', or
  32 ;; automatically after a suitable idle time, through the customizable
  33 ;; variable `help-at-pt-display-when-idle'.
  34 ;;
  35 ;; You can get a more global overview of the local help available in
  36 ;; the buffer, using the commands `scan-buf-next-region' and
  37 ;; `scan-buf-previous-region', which move to the start of the next or
  38 ;; previous region with available local help and print the help found
  39 ;; there.
  40 ;;
  41 ;; Suggested key bindings:
  42 ;;
  43 ;; (global-set-key [C-tab] 'scan-buf-next-region)
  44 ;; (global-set-key [C-M-tab] 'scan-buf-previous-region)
  45 ;;
  46 ;; You do not have to do anything special to use the functionality
  47 ;; provided by this file, because all important functions autoload.
  48
  49 ;;; Code:
  50
  51 (defgroup help-at-pt nil
  52   "Features for displaying local help."
  53   :group 'help
  54   :version "22.1")
  55
  56 ;;;###autoload
  57 (defun help-at-pt-string (&optional kbd)
  58   "Return the help-echo string at point.
  59 Normally, the string produced by the `help-echo' text or overlay
  60 property, or nil, is returned.
  61 If KBD is non-nil, `kbd-help' is used instead, and any
  62 `help-echo' property is ignored.  In this case, the return value
  63 can also be t, if that is the value of the `kbd-help' property."
  64   (save-excursion
  65     (let* ((prop (if kbd 'kbd-help 'help-echo))
  66            (pair (get-char-property-and-overlay (point) prop))
  67            (pair (if (car pair) pair
  68                      (unless (bobp)
  69                        (backward-char)
  70                        (get-char-property-and-overlay (point) prop))))
  71            (val (car pair))
  72            (ov (cdr pair)))
  73       (if (functionp val)
  74           (funcall val (selected-window) (if ov ov (current-buffer)) (point))
  75           (eval val)))))
  76
  77 ;;;###autoload
  78 (defun help-at-pt-kbd-string ()
  79   "Return the keyboard help string at point.
  80 If the `kbd-help' text or overlay property at point produces a
  81 string, return it.  Otherwise, use the `help-echo' property.
  82 If this produces no string either, return nil."
  83   (let ((kbd (help-at-pt-string t))
  84         (echo (help-at-pt-string)))
  85     (if (and kbd (not (eq kbd t))) kbd echo)))
  86
  87 ;;;###autoload
  88 (defun display-local-help (&optional arg)
  89   "Display local help in the echo area.
  90 This displays a short help message, namely the string produced by
  91 the `kbd-help' property at point.  If `kbd-help' does not produce
  92 a string, but the `help-echo' property does, then that string is
  93 printed instead.
  94
  95 A numeric argument ARG prevents display of a message in case
  96 there is no help.  While ARG can be used interactively, it is
  97 mainly meant for use from Lisp."
  98   (interactive "P")
  99   (let ((help (help-at-pt-kbd-string)))
 100     (if help
 101         (message "%s" help)
 102       (if (not arg) (message "No local help at point")))))
 103
 104 (defvar help-at-pt-timer nil
 105   "Non-nil means that a timer is set that checks for local help.
 106 If non-nil, this is the value returned by the call of
 107 `run-with-idle-timer' that set that timer.  This variable is used
 108 internally to enable `help-at-pt-display-when-idle'.  Do not set it
 109 yourself.")
 110
 111 (defcustom help-at-pt-timer-delay 1
 112   "Delay before displaying local help.
 113 This is used if `help-at-pt-display-when-idle' is enabled.
 114 The value may be an integer or floating point number.
 115
 116 If a timer is already active, there are two ways to make the new
 117 value take effect immediately.  After setting the value, you can
 118 first call `help-at-pt-cancel-timer' and then set a new timer
 119 with `help-at-pt-set-timer'.  Alternatively, you can set this
 120 variable through Custom.  This will not set a timer if none is
 121 active, but if one is already active, Custom will make it use the
 122 new value."
 123   :group 'help-at-pt
 124   :type 'number
 125   :initialize 'custom-initialize-default
 126   :set (lambda (variable value)
 127          (set-default variable value)
 128          (and (boundp 'help-at-pt-timer)
 129               help-at-pt-timer
 130               (timer-set-idle-time help-at-pt-timer value t))))
 131
 132 ;;;###autoload
 133 (defun help-at-pt-cancel-timer ()
 134   "Cancel any timer set by `help-at-pt-set-timer'.
 135 This disables `help-at-pt-display-when-idle'."
 136   (interactive)
 137   (let ((inhibit-quit t))
 138     (when help-at-pt-timer
 139       (cancel-timer help-at-pt-timer)
 140       (setq help-at-pt-timer nil))))
 141
 142 ;;;###autoload
 143 (defun help-at-pt-set-timer ()
 144   "Enable `help-at-pt-display-when-idle'.
 145 This is done by setting a timer, if none is currently active."
 146   (interactive)
 147   (unless help-at-pt-timer
 148     (setq help-at-pt-timer
 149           (run-with-idle-timer
 150            help-at-pt-timer-delay t #'help-at-pt-maybe-display))))
 151
 152 ;;;###autoload
 153 (defcustom help-at-pt-display-when-idle 'never
 154   "Automatically show local help on point-over.
 155 If the value is t, the string obtained from any `kbd-help' or
 156 `help-echo' property at point is automatically printed in the
 157 echo area, if nothing else is already displayed there, or after a
 158 quit.  If both `kbd-help' and `help-echo' produce help strings,
 159 `kbd-help' is used.  If the value is a list, the help only gets
 160 printed if there is a text or overlay property at point that is
 161 included in this list.  Suggested properties are `keymap',
 162 `local-map', `button' and `kbd-help'.  Any value other than t or
 163 a non-empty list disables the feature.
 164
 165 This variable only takes effect after a call to
 166 `help-at-pt-set-timer'.  The help gets printed after Emacs has
 167 been idle for `help-at-pt-timer-delay' seconds.  You can call
 168 `help-at-pt-cancel-timer' to cancel the timer set by, and the
 169 effect of, `help-at-pt-set-timer'.
 170
 171 When this variable is set through Custom, `help-at-pt-set-timer'
 172 is called automatically, unless the value is `never', in which
 173 case `help-at-pt-cancel-timer' is called.  Specifying an empty
 174 list of properties through Custom will set the timer, thus
 175 enabling buffer local values.  It sets the actual value to nil.
 176 Thus, Custom distinguishes between a nil value and other values
 177 that disable the feature, which Custom identifies with `never'.
 178 The default is `never'."
 179   :group 'help-at-pt
 180   :type '(choice  (const :tag "Always"
 181                          :format "%t\n%h"
 182                          :doc
 183                          "This choice can get noisy.
 184 The text printed from the `help-echo' property is often only
 185 relevant when using the mouse.  If you mind about too many
 186 messages getting printed in the echo area, use \"In certain
 187 situations\".  See the documentation there for more information."
 188                          t)
 189                   (repeat :tag "In certain situations"
 190                           ;; unless we specify 0 offset the doc string
 191                           ;; for this choice gets indented very
 192                           ;; differently than for the other two
 193                           ;; choices, when "More" is selected.
 194                           :offset 0
 195                           :format "%{%t%}:\n%v%i\n%h"
 196                           :doc
 197                           "This choice lets you specify a list of \
 198 text properties.
 199 Presence of any of these properties will trigger display of
 200 available local help on point-over.
 201 If you use this alternative through Custom without listing any
 202 properties, a timer will be set anyway.  This will enable buffer
 203 local values.  Use \"Never\" if you do not want a timer to be set.
 204
 205 Suggested properties:
 206 The `keymap' and `local-map' properties change keybindings in
 207 parts of the buffer.  Some of these keymaps are mode independent
 208 and are not mentioned in the mode documentation.  Hence, the help
 209 text is likely to be useful.
 210 Specifying `button' is relevant in Custom and similar buffers.
 211 In these buffers, most, but not all, of the text shown this way is
 212 available by default when using tab, but not on regular point-over.
 213 The presence of a `kbd-help' property guarantees that non mouse
 214 specific help is available."
 215                           :value (keymap local-map button kbd-help)
 216                           symbol)
 217                   (other :tag "Never"
 218                          :format "%t\n%h"
 219                          :doc
 220                          "This choice normally disables buffer local values.
 221 If you choose this value through Custom and a timer checking for
 222 local help is currently active, it will be canceled.  No new
 223 timer will be set.  Call `help-at-pt-set-timer' after choosing
 224 this option, or use \"In certain situations\" and specify no text
 225 properties, to enable buffer local values."
 226                          never))
 227   :initialize 'custom-initialize-default
 228   :set #'(lambda (variable value)
 229            (set-default variable value)
 230            (if (eq value 'never)
 231                (help-at-pt-cancel-timer)
 232              (help-at-pt-set-timer)))
 233   :set-after '(help-at-pt-timer-delay)
 234   :require 'help-at-pt)
 235
 236 ;; Function for use in `help-at-pt-set-timer'.
 237 (defun help-at-pt-maybe-display ()
 238   (and (or (eq help-at-pt-display-when-idle t)
 239            (and (consp help-at-pt-display-when-idle)
 240                 (catch 'found
 241                   (dolist (prop help-at-pt-display-when-idle)
 242                     (if (get-char-property (point) prop)
 243                         (throw 'found t)))
 244                   (unless (bobp)
 245                     (save-excursion
 246                       (backward-char)
 247                       (dolist (prop help-at-pt-display-when-idle)
 248                         (if (get-char-property (point) prop)
 249                             (throw 'found t))))))))
 250        (or (not (current-message))
 251            (string= (current-message) "Quit"))
 252        (display-local-help t)))
 253
 254 ;;;###autoload
 255 (defun scan-buf-move-to-region (prop &optional arg hook)
 256   "Go to the start of the next region with non-nil PROP property.
 257 Then run HOOK, which should be a quoted symbol that is a normal
 258 hook variable, or an expression evaluating to such a symbol.
 259 Adjacent areas with different non-nil PROP properties are
 260 considered different regions.
 261
 262 With numeric argument ARG, move to the start of the ARGth next
 263 such region, then run HOOK.  If ARG is negative, move backward.
 264 If point is already in a region, then that region does not count
 265 toward ARG.  If ARG is 0 and point is inside a region, move to
 266 the start of that region.  If ARG is 0 and point is not in a
 267 region, print a message to that effect, but do not move point and
 268 do not run HOOK.  If there are not enough regions to move over,
 269 an error results and the number of available regions is mentioned
 270 in the error message.  Point is not moved and HOOK is not run."
 271   (cond ((> arg 0)
 272          (if (= (point) (point-max))
 273              (error "No further `%s' regions" prop))
 274          (let ((pos (point)))
 275            (dotimes (x arg)
 276              (setq pos (next-single-char-property-change pos prop))
 277              (unless (get-char-property pos prop)
 278                (setq pos (next-single-char-property-change pos prop))
 279                (unless (get-char-property pos prop)
 280                  (cond ((= x 0)
 281                         (error "No further `%s' regions" prop))
 282                        ((= x 1)
 283                         (error "There is only one further `%s' region" prop))
 284                        (t
 285                         (error
 286                          "There are only %d further `%s' regions"
 287                          x prop))))))
 288            (goto-char pos)
 289            (run-hooks hook)))
 290         ((= arg 0)
 291          (let ((val (get-char-property (point) prop)))
 292            (cond ((not val)
 293                   (message "Point is not in a `%s' region" prop))
 294                  ((eq val (get-char-property (1- (point)) prop))
 295                   (goto-char
 296                    (previous-single-char-property-change (point) prop))
 297                   (run-hooks hook))
 298                  (t (run-hooks hook)))))
 299         ((< arg 0)
 300          (let ((pos (point)) (val (get-char-property (point) prop)))
 301            (and val
 302                 (eq val (get-char-property (1- pos) prop))
 303                 (setq pos
 304                       (previous-single-char-property-change pos prop)))
 305            (if (= pos (point-min))
 306                (error "No prior `%s' regions" prop))
 307            (dotimes (x (- arg))
 308              (setq pos (previous-single-char-property-change pos prop))
 309              (unless (get-char-property pos prop)
 310                (setq pos (previous-single-char-property-change pos prop))
 311                (unless (get-char-property pos prop)
 312                  (cond ((= x 0)
 313                         (error "No prior `%s' regions" prop))
 314                        ((= x 1)
 315                         (error "There is only one prior `%s' region" prop))
 316                        (t
 317                         (error "There are only %d prior `%s' regions"
 318                                x prop))))))
 319            (goto-char pos)
 320            (run-hooks hook)))))
 321
 322 ;; To be moved to a different file and replaced by a defcustom in a
 323 ;; future version.
 324 (defvar scan-buf-move-hook '(display-local-help)
 325   "Normal hook run by `scan-buf-next-region'.
 326 Also used by `scan-buf-previous-region'.  The hook is run after
 327 positioning point.")
 328
 329 ;;;###autoload
 330 (defun scan-buf-next-region (&optional arg)
 331   "Go to the start of the next region with non-nil help-echo.
 332 Print the help found there using `display-local-help'.  Adjacent
 333 areas with different non-nil help-echo properties are considered
 334 different regions.
 335
 336 With numeric argument ARG, move to the start of the ARGth next
 337 help-echo region.  If ARG is negative, move backward.  If point
 338 is already in a help-echo region, then that region does not count
 339 toward ARG.  If ARG is 0 and point is inside a help-echo region,
 340 move to the start of that region.  If ARG is 0 and point is not
 341 in such a region, just print a message to that effect.  If there
 342 are not enough regions to move over, an error results and the
 343 number of available regions is mentioned in the error message.
 344
 345 A potentially confusing subtlety is that point can be in a
 346 help-echo region without any local help being available.  This is
 347 because `help-echo' can be a function evaluating to nil.  This
 348 rarely happens in practice."
 349   (interactive "p")
 350   (scan-buf-move-to-region 'help-echo arg 'scan-buf-move-hook))
 351
 352 ;;;###autoload
 353 (defun scan-buf-previous-region (&optional arg)
 354   "Go to the start of the previous region with non-nil help-echo.
 355 Print the help found there using `display-local-help'.  Adjacent
 356 areas with different non-nil help-echo properties are considered
 357 different regions.  With numeric argument ARG, behaves like
 358 `scan-buf-next-region' with argument -ARG."
 359   (interactive "p")
 360   (scan-buf-move-to-region 'help-echo (- arg) 'scan-buf-move-hook))
 361
 362 (provide 'help-at-pt)
 363
 364 ;;; help-at-pt.el ends here