lisp/help-at-pt.el

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