nxhtml/util/hl-needed.el

   1 ;;; hl-needed.el --- Turn on highlighting of line and column when needed
   2 ;;
   3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
   4 ;; Created: Fri Nov 30 21:19:18 2007
   5 ;; Version: 0.60
   6 ;; Last-Updated: 2010-03-19 Fri
   7 ;; URL: http://www.emacswiki.org/cgi-bin/wiki/hl-needed.el
   8 ;; Keywords:
   9 ;; Compatibility:
  10 ;;
  11 ;; Features that might be required by this library:
  12 ;;
  13   ;; `hl-line', `vline'.
  14 ;;
  15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16 ;;
  17 ;;; Commentary:
  18 ;;
  19 ;; This is yet another highlight line and/or column idea.  The idea is
  20 ;; to try to show line and column only when it is probably most
  21 ;; needed.  See `hl-needed-mode' for more info.
  22 ;;
  23 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  24 ;;
  25 ;;; Change log:
  26 ;;
  27 ;;
  28 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  29 ;;
  30 ;; This program is free software; you can redistribute it and/or
  31 ;; modify it under the terms of the GNU General Public License as
  32 ;; published by the Free Software Foundation; either version 2, or
  33 ;; (at your option) any later version.
  34 ;;
  35 ;; This program is distributed in the hope that it will be useful,
  36 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  37 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  38 ;; General Public License for more details.
  39 ;;
  40 ;; You should have received a copy of the GNU General Public License
  41 ;; along with this program; see the file COPYING.  If not, write to
  42 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
  43 ;; Floor, Boston, MA 02110-1301, USA.
  44 ;;
  45 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  46 ;;
  47 ;;; Code:
  48
  49 (require 'hl-line)
  50 (require 'vline nil t)
  51
  52 ;;;###autoload
  53 (defgroup hl-needed nil
  54   "Customization group for `hl-needed-mode'."
  55   :group 'convenience)
  56
  57 (defcustom hl-needed-always nil
  58   "Highlight always.
  59 This is similar to turning on `vline-mode' and `hl-line-mode'"
  60   :type 'boolean
  61   :group 'hl-needed)
  62
  63 (defcustom hl-needed-mark-line t
  64   "Highlight line."
  65   :type 'boolean
  66   :group 'hl-needed)
  67
  68 (defcustom hl-needed-mark-column t
  69   "Highlight column."
  70   :type 'boolean
  71   :group 'hl-needed)
  72
  73 (defcustom hl-needed-in-readonly-buffers nil
  74   "Do not highlight in read-only buffers unless non-nil."
  75   :type 'boolean
  76   :group 'hl-needed)
  77
  78 (defcustom hl-needed-not-in-modes
  79   '(wab-compilation-mode
  80     custom-mode)
  81   "List of modes where highlighting should not be done."
  82   :type '(repeat function)
  83   :group 'hl-needed)
  84
  85 ;;(setq hl-needed-idle-time 5)
  86 (defcustom hl-needed-idle-time 20
  87   "Highligh current line and/or column if Emacs is idle for more seconds.
  88 If nil do not turn on `hl-line-mode' when Emacs is idle."
  89   :type '(choice (const :tag "Don't turn on when Emacs is idle" nil)
  90                  (integer :tag "Turn on after (seconds)"))
  91   :group 'hl-needed)
  92
  93 (defcustom hl-needed-on-mouse t
  94   "Highlight current line and/or column on clicks."
  95   :type 'boolean
  96   :group 'hl-needed)
  97
  98 (defcustom hl-needed-on-new-window t
  99   "Highlight current line and/or column on new window selection."
 100   :type 'boolean
 101   :group 'hl-needed)
 102
 103 (defcustom hl-needed-on-new-buffer t
 104   "Highlight current line and/or column on new buffer selection."
 105   :type 'boolean
 106   :group 'hl-needed)
 107
 108 (defcustom hl-needed-on-config-change t
 109   "Highlight current line and/or column on window conf change."
 110   :type 'boolean
 111   :group 'hl-needed)
 112
 113 (defcustom hl-needed-on-scrolling t
 114   "Highlight current line and/or column after scrolling."
 115   :type 'boolean
 116   :group 'hl-needed)
 117
 118 (defvar hl-needed-face 'hl-needed-face)
 119 (defface hl-needed-face
 120   '((t (:inherit highlight)))
 121   "Face for flashing."
 122   :group 'hl-needed)
 123
 124 (defcustom hl-needed-flash-delay 0.0
 125   "Time to wait before turning on flash highlighting.
 126 If a key is pressed before this flash highlighting is not done."
 127   :type 'float
 128   :group 'hl-needed)
 129
 130 (defcustom hl-needed-flash-duration 1.0
 131   "Turn off flash highlighting after this number of second.
 132 Highlighting is turned off only if it was turned on because of
 133 some change. It will not be turned off if it was turned on
 134 because Emacs was idle for more than `hl-needed-idle-time'.
 135
 136 The default time is choosen to not disturb too much. I believe
 137 human short attention may often be of this time. \(Compare eye
 138 contact time.)"
 139   :type 'float
 140   :group 'hl-needed)
 141
 142 (defcustom hl-needed-currently-fun 'hl-needed-currently
 143   "Function that checks if highlighting should be done.
 144 The function should return nil if not needed and non-nil
 145 otherwise."
 146   :type 'function
 147   :group 'hl-needed)
 148
 149 (defvar hl-needed-mode-map
 150   (let ((map (make-sparse-keymap)))
 151     (define-key map [(control ?c) ?? ??] 'hl-needed-show)
 152     map))
 153
 154 ;;;###autoload
 155 (define-minor-mode hl-needed-mode
 156   "Try to highlight current line and column when needed.
 157 This is a global minor mode.  It can operate in some different
 158 ways:
 159
 160 - Highlighting can be on always, see `hl-needed-always'.
 161
 162 Or, it can be turned on depending on some conditions.  In this
 163 case highlighting is turned off after each command and turned on
 164 again in the current window when either:
 165
 166 - A new window was selected, see `hl-needed-on-new-window'.
 167 - A new buffer was selected, see `hl-needed-on-new-buffer'.
 168 - Window configuration was changed, see `hl-needed-on-config-change'.
 169 - Buffer was scrolled see `hl-needed-on-scrolling'.
 170 - A window was clicked with the mouse, see `hl-needed-on-mouse'.
 171
 172 After this highlighting may be turned off again, normally after a
 173 short delay, see `hl-needed-flash'.
 174
 175 If either highlighting was not turned on or was turned off again
 176 it will be turned on when
 177
 178 - Emacs has been idle for `hl-needed-idle-time' seconds.
 179
 180 See also `hl-needed-not-in-modes' and `hl-needed-currently-fun'.
 181
 182 Note 1: For columns to be highlighted vline.el must be available.
 183
 184 Note 2: This mode depends on `hl-line-mode' and `vline-mode' and
 185 tries to cooperate with them. If you turn on either of these that
 186 overrides the variables for turning on the respective
 187 highlighting here."
 188   :global t
 189   :group 'hl-needed
 190   ;;:keymap hl-needed-mode-map
 191   (if hl-needed-mode
 192       (progn
 193         ;;(unless (memq major-mode hl-needed-not-in-modes) (setq hl-needed-window t))
 194         (when (featurep 'hl-needed) (hl-needed-show))
 195         (add-hook 'post-command-hook 'hl-needed-post-command)
 196         (add-hook 'pre-command-hook 'hl-needed-pre-command)
 197         (add-hook 'window-configuration-change-hook 'hl-needed-config-change)
 198         )
 199     (remove-hook 'post-command-hook 'hl-needed-post-command)
 200     (remove-hook 'pre-command-hook 'hl-needed-pre-command)
 201     (remove-hook 'window-configuration-change-hook 'hl-needed-config-change)
 202     (hl-needed-cancel-timer)
 203     (hl-needed-cancel-flash-timer)
 204     (hl-needed-hide)))
 205
 206 (defvar hl-needed-timer nil)
 207 (defvar hl-needed-flash-timer nil)
 208 (defvar hl-needed-window nil)
 209 (defvar hl-needed-buffer nil)
 210 (defvar hl-needed-window-start nil)
 211 (defvar hl-needed-flash-this nil)
 212 (defvar hl-needed-config-change nil)
 213
 214 (defvar hl-needed-old-blink nil)
 215 (defun hl-needed-show ()
 216   "Highlight current line and/or column now."
 217   (interactive)
 218   (when (with-no-warnings (called-interactively-p))
 219     (setq hl-needed-flash-this nil)
 220     (unless hl-needed-mode
 221       (message "Use hl-needed-hide to remove highlighting")))
 222   (setq hl-needed-old-blink nil) ;; So blink is not turned on by hl-needed-hide
 223   (hl-needed-hide)
 224   (unless (active-minibuffer-window)
 225     (setq hl-needed-old-blink blink-cursor-mode)
 226     (when blink-cursor-mode
 227       (blink-cursor-mode -1)
 228       ;;(when (timerp blink-cursor-timer) (cancel-timer blink-cursor-timer))
 229       (blink-cursor-end)
 230       )
 231     (unless hl-line-mode
 232       (when hl-needed-mark-line
 233         (let ((hl-line-mode t)
 234               (hl-line-sticky-flag nil)
 235               (hl-line-face hl-needed-face))
 236           (hl-line-highlight))))
 237     (unless vline-mode
 238       (when hl-needed-mark-column
 239         (when (featurep 'vline)
 240           (let ((vline-style 'face)
 241                 (vline-face hl-line-face)
 242                 (vline-current-window-only t))
 243             (vline-show)))))))
 244
 245 (defun hl-needed-hide ()
 246   (interactive)
 247   (when (and hl-needed-old-blink
 248              (not blink-cursor-mode))
 249     (blink-cursor-mode 1))
 250   (setq hl-needed-old-blink nil)
 251   (unless hl-line-mode
 252     (hl-line-unhighlight))
 253   (when (featurep 'vline)
 254     (unless vline-mode
 255       (vline-clear))))
 256
 257 (defun hl-needed-cancel-timer ()
 258   (when (timerp hl-needed-timer) (cancel-timer hl-needed-timer))
 259   (setq hl-needed-timer nil))
 260
 261 (defun hl-needed-start-timer (wait)
 262   (hl-needed-cancel-timer)
 263   (setq hl-needed-timer
 264         (run-with-idle-timer wait
 265                              nil 'hl-needed-show-in-timer)))
 266
 267 (defun hl-needed-show-in-timer ()
 268   "Turn on with special error handling.
 269 Erros may go unnoticed in timers.  This should prevent it."
 270   (condition-case err
 271       (save-match-data ;; runs in timer
 272         (hl-needed-show))
 273     (error
 274      (lwarn 'hl-needed-show
 275             :error "%s" (error-message-string err)))))
 276
 277 (defun hl-needed-hide-in-timer ()
 278   "Turn off with special error handling.
 279 Erros may go unnoticed in timers.  This should prevent it."
 280   (condition-case err
 281       (unless hl-needed-always
 282         (hl-needed-hide))
 283     (error
 284      (lwarn 'hl-needed-hide
 285             :error "%s" (error-message-string err)))))
 286
 287 (defun hl-needed-hide-flash-in-timer ()
 288   "Turn off with special error handling.
 289 Erros may go unnoticed in timers.  This should prevent it."
 290   (condition-case err
 291       (unless hl-needed-always
 292         (hl-needed-hide)
 293         (hl-needed-start-timer hl-needed-idle-time))
 294     (error
 295      (lwarn 'hl-needed-hide
 296             :error "%s" (error-message-string err)))))
 297
 298 (defun hl-needed-currently ()
 299   "Check if `hl-line-mode' is needed in buffer."
 300   ;; Check for change of buffer and window
 301   (if hl-needed-always
 302       t
 303     (unless (or (memq major-mode hl-needed-not-in-modes)
 304                 isearch-mode
 305                 (and buffer-read-only
 306                      (not hl-needed-in-readonly-buffers)))
 307       (or (and hl-needed-on-new-window
 308                (not (eq hl-needed-window (selected-window))))
 309           ;;(progn (message "here1") nil)
 310           (and hl-needed-on-new-buffer
 311                (not (eq hl-needed-buffer (current-buffer))))
 312           ;;(progn (message "here2") nil)
 313           (and hl-needed-on-config-change
 314                hl-needed-config-change)
 315           ;;(progn (message "here3") nil)
 316           (and hl-needed-on-mouse
 317                (listp last-input-event)
 318                (memq (car last-input-event) '(mouse-1 mouse-2 mouse-3)))
 319           ;;(progn (message "here4") nil)
 320           (and hl-needed-on-scrolling
 321                (and (not (eq hl-needed-window-start (window-start)))
 322                     (< 1
 323                        (abs
 324                         (- (line-number-at-pos hl-needed-window-start)
 325                            (line-number-at-pos (window-start)))))))))))
 326
 327 (defun hl-needed-cancel-flash-timer ()
 328     (when (timerp hl-needed-flash-timer) (cancel-timer hl-needed-flash-timer))
 329     (setq hl-needed-flash-timer nil))
 330
 331 (defun hl-needed-start-maybe-flash-timer ()
 332   (when (and hl-needed-flash-this
 333              (not hl-needed-always))
 334     (hl-needed-cancel-flash-timer)
 335     (setq hl-needed-flash-timer
 336           (run-with-timer (+ hl-needed-flash-delay hl-needed-flash-duration)
 337                           nil 'hl-needed-hide-flash-in-timer))))
 338
 339 (defvar hl-needed-pre-command-time (current-time))
 340
 341 (defun hl-needed-check ()
 342   ;; Cancel `hl-line-mode' and timer
 343   (unless (active-minibuffer-window)
 344     (if (funcall hl-needed-currently-fun)
 345         (progn
 346           ;; Some time calc for things that pause to show us where we are:
 347           (let* ((time-pre hl-needed-pre-command-time)
 348                 (time-now (current-time))
 349                 (pre (+ (nth 1 time-pre) (* 0.0000001 (nth 2 time-pre))))
 350                 (now (+ (nth 1 time-now) (* 0.0000001 (nth 2 time-now)))))
 351             (if (< 1 (- now pre)) ;; Fix-me: option?
 352                 nil ;; Don't show anything here, it just disturbs
 353               ;;(hl-needed-show)
 354               (hl-needed-start-timer hl-needed-flash-delay)
 355               (hl-needed-start-maybe-flash-timer))))
 356       ;; Submit an idle timer that can turn highlighting on.
 357       (hl-needed-start-timer hl-needed-idle-time)))
 358     (setq hl-needed-config-change nil)
 359     (unless (active-minibuffer-window)
 360       (setq hl-needed-window (selected-window))
 361       (setq hl-needed-buffer (current-buffer))
 362       (setq hl-needed-window-start (window-start))))
 363
 364 (defvar hl-needed-after-active-minibuffer nil)
 365
 366 (defun hl-needed-pre-command ()
 367   ;;(message "active-minibuffer-window=%s" (active-minibuffer-window))
 368   (setq hl-needed-after-active-minibuffer (active-minibuffer-window))
 369   (condition-case err
 370       (progn
 371         (hl-needed-cancel-timer)
 372         (hl-needed-cancel-flash-timer)
 373         (hl-needed-hide)
 374         (setq hl-needed-flash-this hl-needed-flash-duration)
 375         (setq hl-needed-pre-command-time (current-time)))
 376     (error
 377      (message "hl-needed-pre-command error: %s" err))))
 378
 379 (defun hl-needed-post-command ()
 380   (condition-case err
 381       (if (eq last-command 'keyboard-quit)
 382           (hl-needed-hide)
 383         (hl-needed-check))
 384     (error
 385      (message "hl-needed-post-command error: %s" err))))
 386
 387 (defvar hl-needed-minibuffer-active nil)
 388
 389 (defun hl-needed-config-change ()
 390   (condition-case err
 391       (if (active-minibuffer-window)
 392           (setq hl-needed-minibuffer-active t)
 393         ;; Changing buffer in the echo area is a config change. Catch this:
 394         (setq hl-needed-config-change (not hl-needed-after-active-minibuffer))
 395         (setq hl-needed-after-active-minibuffer nil)
 396         (setq hl-needed-minibuffer-active nil))
 397     (error
 398      (message "hl-needed-config-change error: %s" err))))
 399
 400 (provide 'hl-needed)
 401 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 402 ;;; hl-needed.el ends here