403 lines
14 KiB
EmacsLisp
403 lines
14 KiB
EmacsLisp
|
;;; hl-needed.el --- Turn on highlighting of line and column when needed
|
||
|
|
;;
|
||
|
|
;; Author: Lennart Borgman (lennart O borgman A gmail O com)
|
||
|
|
;; Created: Fri Nov 30 21:19:18 2007
|
||
|
|
;; Version: 0.60
|
||
|
|
;; Last-Updated: 2010-03-19 Fri
|
||
|
|
;; URL: http://www.emacswiki.org/cgi-bin/wiki/hl-needed.el
|
||
|
|
;; Keywords:
|
||
|
|
;; Compatibility:
|
||
|
|
;;
|
||
|
|
;; Features that might be required by this library:
|
||
|
|
;;
|
||
|
|
;; `hl-line', `vline'.
|
||
|
|
;;
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;
|
||
|
|
;;; Commentary:
|
||
|
|
;;
|
||
|
|
;; This is yet another highlight line and/or column idea. The idea is
|
||
|
|
;; to try to show line and column only when it is probably most
|
||
|
|
;; needed. See `hl-needed-mode' for more info.
|
||
|
|
;;
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;
|
||
|
|
;;; Change log:
|
||
|
|
;;
|
||
|
|
;;
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;
|
||
|
|
;; This program is free software; you can redistribute it and/or
|
||
|
|
;; modify it under the terms of the GNU General Public License as
|
||
|
|
;; published by the Free Software Foundation; either version 2, or
|
||
|
|
;; (at your option) any later version.
|
||
|
|
;;
|
||
|
|
;; This program is distributed in the hope that it will be useful,
|
||
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||
|
|
;; General Public License for more details.
|
||
|
|
;;
|
||
|
|
;; You should have received a copy of the GNU General Public License
|
||
|
|
;; along with this program; see the file COPYING. If not, write to
|
||
|
|
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
|
||
|
|
;; Floor, Boston, MA 02110-1301, USA.
|
||
|
|
;;
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;
|
||
|
|
;;; Code:
|
||
|
|
|
||
|
|
(require 'hl-line)
|
||
|
|
(require 'vline nil t)
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(defgroup hl-needed nil
|
||
|
|
"Customization group for `hl-needed-mode'."
|
||
|
|
:group 'convenience)
|
||
|
|
|
||
|
|
(defcustom hl-needed-always nil
|
||
|
|
"Highlight always.
|
||
|
|
This is similar to turning on `vline-mode' and `hl-line-mode'"
|
||
|
|
:type 'boolean
|
||
|
|
:group 'hl-needed)
|
||
|
|
|
||
|
|
(defcustom hl-needed-mark-line t
|
||
|
|
"Highlight line."
|
||
|
|
:type 'boolean
|
||
|
|
:group 'hl-needed)
|
||
|
|
|
||
|
|
(defcustom hl-needed-mark-column t
|
||
|
|
"Highlight column."
|
||
|
|
:type 'boolean
|
||
|
|
:group 'hl-needed)
|
||
|
|
|
||
|
|
(defcustom hl-needed-in-readonly-buffers nil
|
||
|
|
"Do not highlight in read-only buffers unless non-nil."
|
||
|
|
:type 'boolean
|
||
|
|
:group 'hl-needed)
|
||
|
|
|
||
|
|
(defcustom hl-needed-not-in-modes
|
||
|
|
'(wab-compilation-mode
|
||
|
|
custom-mode)
|
||
|
|
"List of modes where highlighting should not be done."
|
||
|
|
:type '(repeat function)
|
||
|
|
:group 'hl-needed)
|
||
|
|
|
||
|
|
;;(setq hl-needed-idle-time 5)
|
||
|
|
(defcustom hl-needed-idle-time 20
|
||
|
|
"Highligh current line and/or column if Emacs is idle for more seconds.
|
||
|
|
If nil do not turn on `hl-line-mode' when Emacs is idle."
|
||
|
|
:type '(choice (const :tag "Don't turn on when Emacs is idle" nil)
|
||
|
|
(integer :tag "Turn on after (seconds)"))
|
||
|
|
:group 'hl-needed)
|
||
|
|
|
||
|
|
(defcustom hl-needed-on-mouse t
|
||
|
|
"Highlight current line and/or column on clicks."
|
||
|
|
:type 'boolean
|
||
|
|
:group 'hl-needed)
|
||
|
|
|
||
|
|
(defcustom hl-needed-on-new-window t
|
||
|
|
"Highlight current line and/or column on new window selection."
|
||
|
|
:type 'boolean
|
||
|
|
:group 'hl-needed)
|
||
|
|
|
||
|
|
(defcustom hl-needed-on-new-buffer t
|
||
|
|
"Highlight current line and/or column on new buffer selection."
|
||
|
|
:type 'boolean
|
||
|
|
:group 'hl-needed)
|
||
|
|
|
||
|
|
(defcustom hl-needed-on-config-change t
|
||
|
|
"Highlight current line and/or column on window conf change."
|
||
|
|
:type 'boolean
|
||
|
|
:group 'hl-needed)
|
||
|
|
|
||
|
|
(defcustom hl-needed-on-scrolling t
|
||
|
|
"Highlight current line and/or column after scrolling."
|
||
|
|
:type 'boolean
|
||
|
|
:group 'hl-needed)
|
||
|
|
|
||
|
|
(defvar hl-needed-face 'hl-needed-face)
|
||
|
|
(defface hl-needed-face
|
||
|
|
'((t (:inherit highlight)))
|
||
|
|
"Face for flashing."
|
||
|
|
:group 'hl-needed)
|
||
|
|
|
||
|
|
(defcustom hl-needed-flash-delay 0.0
|
||
|
|
"Time to wait before turning on flash highlighting.
|
||
|
|
If a key is pressed before this flash highlighting is not done."
|
||
|
|
:type 'float
|
||
|
|
:group 'hl-needed)
|
||
|
|
|
||
|
|
(defcustom hl-needed-flash-duration 1.0
|
||
|
|
"Turn off flash highlighting after this number of second.
|
||
|
|
Highlighting is turned off only if it was turned on because of
|
||
|
|
some change. It will not be turned off if it was turned on
|
||
|
|
because Emacs was idle for more than `hl-needed-idle-time'.
|
||
|
|
|
||
|
|
The default time is choosen to not disturb too much. I believe
|
||
|
|
human short attention may often be of this time. \(Compare eye
|
||
|
|
contact time.)"
|
||
|
|
:type 'float
|
||
|
|
:group 'hl-needed)
|
||
|
|
|
||
|
|
(defcustom hl-needed-currently-fun 'hl-needed-currently
|
||
|
|
"Function that checks if highlighting should be done.
|
||
|
|
The function should return nil if not needed and non-nil
|
||
|
|
otherwise."
|
||
|
|
:type 'function
|
||
|
|
:group 'hl-needed)
|
||
|
|
|
||
|
|
(defvar hl-needed-mode-map
|
||
|
|
(let ((map (make-sparse-keymap)))
|
||
|
|
(define-key map [(control ?c) ?? ??] 'hl-needed-show)
|
||
|
|
map))
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(define-minor-mode hl-needed-mode
|
||
|
|
"Try to highlight current line and column when needed.
|
||
|
|
This is a global minor mode. It can operate in some different
|
||
|
|
ways:
|
||
|
|
|
||
|
|
- Highlighting can be on always, see `hl-needed-always'.
|
||
|
|
|
||
|
|
Or, it can be turned on depending on some conditions. In this
|
||
|
|
case highlighting is turned off after each command and turned on
|
||
|
|
again in the current window when either:
|
||
|
|
|
||
|
|
- A new window was selected, see `hl-needed-on-new-window'.
|
||
|
|
- A new buffer was selected, see `hl-needed-on-new-buffer'.
|
||
|
|
- Window configuration was changed, see `hl-needed-on-config-change'.
|
||
|
|
- Buffer was scrolled see `hl-needed-on-scrolling'.
|
||
|
|
- A window was clicked with the mouse, see `hl-needed-on-mouse'.
|
||
|
|
|
||
|
|
After this highlighting may be turned off again, normally after a
|
||
|
|
short delay, see `hl-needed-flash'.
|
||
|
|
|
||
|
|
If either highlighting was not turned on or was turned off again
|
||
|
|
it will be turned on when
|
||
|
|
|
||
|
|
- Emacs has been idle for `hl-needed-idle-time' seconds.
|
||
|
|
|
||
|
|
See also `hl-needed-not-in-modes' and `hl-needed-currently-fun'.
|
||
|
|
|
||
|
|
Note 1: For columns to be highlighted vline.el must be available.
|
||
|
|
|
||
|
|
Note 2: This mode depends on `hl-line-mode' and `vline-mode' and
|
||
|
|
tries to cooperate with them. If you turn on either of these that
|
||
|
|
overrides the variables for turning on the respective
|
||
|
|
highlighting here."
|
||
|
|
:global t
|
||
|
|
:group 'hl-needed
|
||
|
|
;;:keymap hl-needed-mode-map
|
||
|
|
(if hl-needed-mode
|
||
|
|
(progn
|
||
|
|
;;(unless (memq major-mode hl-needed-not-in-modes) (setq hl-needed-window t))
|
||
|
|
(when (featurep 'hl-needed) (hl-needed-show))
|
||
|
|
(add-hook 'post-command-hook 'hl-needed-post-command)
|
||
|
|
(add-hook 'pre-command-hook 'hl-needed-pre-command)
|
||
|
|
(add-hook 'window-configuration-change-hook 'hl-needed-config-change)
|
||
|
|
)
|
||
|
|
(remove-hook 'post-command-hook 'hl-needed-post-command)
|
||
|
|
(remove-hook 'pre-command-hook 'hl-needed-pre-command)
|
||
|
|
(remove-hook 'window-configuration-change-hook 'hl-needed-config-change)
|
||
|
|
(hl-needed-cancel-timer)
|
||
|
|
(hl-needed-cancel-flash-timer)
|
||
|
|
(hl-needed-hide)))
|
||
|
|
|
||
|
|
(defvar hl-needed-timer nil)
|
||
|
|
(defvar hl-needed-flash-timer nil)
|
||
|
|
(defvar hl-needed-window nil)
|
||
|
|
(defvar hl-needed-buffer nil)
|
||
|
|
(defvar hl-needed-window-start nil)
|
||
|
|
(defvar hl-needed-flash-this nil)
|
||
|
|
(defvar hl-needed-config-change nil)
|
||
|
|
|
||
|
|
(defvar hl-needed-old-blink nil)
|
||
|
|
(defun hl-needed-show ()
|
||
|
|
"Highlight current line and/or column now."
|
||
|
|
(interactive)
|
||
|
|
(when (with-no-warnings (called-interactively-p))
|
||
|
|
(setq hl-needed-flash-this nil)
|
||
|
|
(unless hl-needed-mode
|
||
|
|
(message "Use hl-needed-hide to remove highlighting")))
|
||
|
|
(setq hl-needed-old-blink nil) ;; So blink is not turned on by hl-needed-hide
|
||
|
|
(hl-needed-hide)
|
||
|
|
(unless (active-minibuffer-window)
|
||
|
|
(setq hl-needed-old-blink blink-cursor-mode)
|
||
|
|
(when blink-cursor-mode
|
||
|
|
(blink-cursor-mode -1)
|
||
|
|
;;(when (timerp blink-cursor-timer) (cancel-timer blink-cursor-timer))
|
||
|
|
(blink-cursor-end)
|
||
|
|
)
|
||
|
|
(unless hl-line-mode
|
||
|
|
(when hl-needed-mark-line
|
||
|
|
(let ((hl-line-mode t)
|
||
|
|
(hl-line-sticky-flag nil)
|
||
|
|
(hl-line-face hl-needed-face))
|
||
|
|
(hl-line-highlight))))
|
||
|
|
(unless vline-mode
|
||
|
|
(when hl-needed-mark-column
|
||
|
|
(when (featurep 'vline)
|
||
|
|
(let ((vline-style 'face)
|
||
|
|
(vline-face hl-line-face)
|
||
|
|
(vline-current-window-only t))
|
||
|
|
(vline-show)))))))
|
||
|
|
|
||
|
|
(defun hl-needed-hide ()
|
||
|
|
(interactive)
|
||
|
|
(when (and hl-needed-old-blink
|
||
|
|
(not blink-cursor-mode))
|
||
|
|
(blink-cursor-mode 1))
|
||
|
|
(setq hl-needed-old-blink nil)
|
||
|
|
(unless hl-line-mode
|
||
|
|
(hl-line-unhighlight))
|
||
|
|
(when (featurep 'vline)
|
||
|
|
(unless vline-mode
|
||
|
|
(vline-clear))))
|
||
|
|
|
||
|
|
(defun hl-needed-cancel-timer ()
|
||
|
|
(when (timerp hl-needed-timer) (cancel-timer hl-needed-timer))
|
||
|
|
(setq hl-needed-timer nil))
|
||
|
|
|
||
|
|
(defun hl-needed-start-timer (wait)
|
||
|
|
(hl-needed-cancel-timer)
|
||
|
|
(setq hl-needed-timer
|
||
|
|
(run-with-idle-timer wait
|
||
|
|
nil 'hl-needed-show-in-timer)))
|
||
|
|
|
||
|
|
(defun hl-needed-show-in-timer ()
|
||
|
|
"Turn on with special error handling.
|
||
|
|
Erros may go unnoticed in timers. This should prevent it."
|
||
|
|
(condition-case err
|
||
|
|
(save-match-data ;; runs in timer
|
||
|
|
(hl-needed-show))
|
||
|
|
(error
|
||
|
|
(lwarn 'hl-needed-show
|
||
|
|
:error "%s" (error-message-string err)))))
|
||
|
|
|
||
|
|
(defun hl-needed-hide-in-timer ()
|
||
|
|
"Turn off with special error handling.
|
||
|
|
Erros may go unnoticed in timers. This should prevent it."
|
||
|
|
(condition-case err
|
||
|
|
(unless hl-needed-always
|
||
|
|
(hl-needed-hide))
|
||
|
|
(error
|
||
|
|
(lwarn 'hl-needed-hide
|
||
|
|
:error "%s" (error-message-string err)))))
|
||
|
|
|
||
|
|
(defun hl-needed-hide-flash-in-timer ()
|
||
|
|
"Turn off with special error handling.
|
||
|
|
Erros may go unnoticed in timers. This should prevent it."
|
||
|
|
(condition-case err
|
||
|
|
(unless hl-needed-always
|
||
|
|
(hl-needed-hide)
|
||
|
|
(hl-needed-start-timer hl-needed-idle-time))
|
||
|
|
(error
|
||
|
|
(lwarn 'hl-needed-hide
|
||
|
|
:error "%s" (error-message-string err)))))
|
||
|
|
|
||
|
|
(defun hl-needed-currently ()
|
||
|
|
"Check if `hl-line-mode' is needed in buffer."
|
||
|
|
;; Check for change of buffer and window
|
||
|
|
(if hl-needed-always
|
||
|
|
t
|
||
|
|
(unless (or (memq major-mode hl-needed-not-in-modes)
|
||
|
|
isearch-mode
|
||
|
|
(and buffer-read-only
|
||
|
|
(not hl-needed-in-readonly-buffers)))
|
||
|
|
(or (and hl-needed-on-new-window
|
||
|
|
(not (eq hl-needed-window (selected-window))))
|
||
|
|
;;(progn (message "here1") nil)
|
||
|
|
(and hl-needed-on-new-buffer
|
||
|
|
(not (eq hl-needed-buffer (current-buffer))))
|
||
|
|
;;(progn (message "here2") nil)
|
||
|
|
(and hl-needed-on-config-change
|
||
|
|
hl-needed-config-change)
|
||
|
|
;;(progn (message "here3") nil)
|
||
|
|
(and hl-needed-on-mouse
|
||
|
|
(listp last-input-event)
|
||
|
|
(memq (car last-input-event) '(mouse-1 mouse-2 mouse-3)))
|
||
|
|
;;(progn (message "here4") nil)
|
||
|
|
(and hl-needed-on-scrolling
|
||
|
|
(and (not (eq hl-needed-window-start (window-start)))
|
||
|
|
(< 1
|
||
|
|
(abs
|
||
|
|
(- (line-number-at-pos hl-needed-window-start)
|
||
|
|
(line-number-at-pos (window-start)))))))))))
|
||
|
|
|
||
|
|
(defun hl-needed-cancel-flash-timer ()
|
||
|
|
(when (timerp hl-needed-flash-timer) (cancel-timer hl-needed-flash-timer))
|
||
|
|
(setq hl-needed-flash-timer nil))
|
||
|
|
|
||
|
|
(defun hl-needed-start-maybe-flash-timer ()
|
||
|
|
(when (and hl-needed-flash-this
|
||
|
|
(not hl-needed-always))
|
||
|
|
(hl-needed-cancel-flash-timer)
|
||
|
|
(setq hl-needed-flash-timer
|
||
|
|
(run-with-timer (+ hl-needed-flash-delay hl-needed-flash-duration)
|
||
|
|
nil 'hl-needed-hide-flash-in-timer))))
|
||
|
|
|
||
|
|
(defvar hl-needed-pre-command-time (current-time))
|
||
|
|
|
||
|
|
(defun hl-needed-check ()
|
||
|
|
;; Cancel `hl-line-mode' and timer
|
||
|
|
(unless (active-minibuffer-window)
|
||
|
|
(if (funcall hl-needed-currently-fun)
|
||
|
|
(progn
|
||
|
|
;; Some time calc for things that pause to show us where we are:
|
||
|
|
(let* ((time-pre hl-needed-pre-command-time)
|
||
|
|
(time-now (current-time))
|
||
|
|
(pre (+ (nth 1 time-pre) (* 0.0000001 (nth 2 time-pre))))
|
||
|
|
(now (+ (nth 1 time-now) (* 0.0000001 (nth 2 time-now)))))
|
||
|
|
(if (< 1 (- now pre)) ;; Fix-me: option?
|
||
|
|
nil ;; Don't show anything here, it just disturbs
|
||
|
|
;;(hl-needed-show)
|
||
|
|
(hl-needed-start-timer hl-needed-flash-delay)
|
||
|
|
(hl-needed-start-maybe-flash-timer))))
|
||
|
|
;; Submit an idle timer that can turn highlighting on.
|
||
|
|
(hl-needed-start-timer hl-needed-idle-time)))
|
||
|
|
(setq hl-needed-config-change nil)
|
||
|
|
(unless (active-minibuffer-window)
|
||
|
|
(setq hl-needed-window (selected-window))
|
||
|
|
(setq hl-needed-buffer (current-buffer))
|
||
|
|
(setq hl-needed-window-start (window-start))))
|
||
|
|
|
||
|
|
(defvar hl-needed-after-active-minibuffer nil)
|
||
|
|
|
||
|
|
(defun hl-needed-pre-command ()
|
||
|
|
;;(message "active-minibuffer-window=%s" (active-minibuffer-window))
|
||
|
|
(setq hl-needed-after-active-minibuffer (active-minibuffer-window))
|
||
|
|
(condition-case err
|
||
|
|
(progn
|
||
|
|
(hl-needed-cancel-timer)
|
||
|
|
(hl-needed-cancel-flash-timer)
|
||
|
|
(hl-needed-hide)
|
||
|
|
(setq hl-needed-flash-this hl-needed-flash-duration)
|
||
|
|
(setq hl-needed-pre-command-time (current-time)))
|
||
|
|
(error
|
||
|
|
(message "hl-needed-pre-command error: %s" err))))
|
||
|
|
|
||
|
|
(defun hl-needed-post-command ()
|
||
|
|
(condition-case err
|
||
|
|
(if (eq last-command 'keyboard-quit)
|
||
|
|
(hl-needed-hide)
|
||
|
|
(hl-needed-check))
|
||
|
|
(error
|
||
|
|
(message "hl-needed-post-command error: %s" err))))
|
||
|
|
|
||
|
|
(defvar hl-needed-minibuffer-active nil)
|
||
|
|
|
||
|
|
(defun hl-needed-config-change ()
|
||
|
|
(condition-case err
|
||
|
|
(if (active-minibuffer-window)
|
||
|
|
(setq hl-needed-minibuffer-active t)
|
||
|
|
;; Changing buffer in the echo area is a config change. Catch this:
|
||
|
|
(setq hl-needed-config-change (not hl-needed-after-active-minibuffer))
|
||
|
|
(setq hl-needed-after-active-minibuffer nil)
|
||
|
|
(setq hl-needed-minibuffer-active nil))
|
||
|
|
(error
|
||
|
|
(message "hl-needed-config-change error: %s" err))))
|
||
|
|
|
||
|
|
(provide 'hl-needed)
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;; hl-needed.el ends here
|