X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e2f9e1b2adc8053e6260757659d2efcd9f645aaf..836c8f066c86d0511a25f4bf926d5cfed1e3a3ef:/lisp/hl-line.el

diff --git a/lisp/hl-line.el b/lisp/hl-line.el
index 4ef227f709..3dd56f2f23 100644
--- a/lisp/hl-line.el
+++ b/lisp/hl-line.el
@@ -1,6 +1,7 @@
 ;;; hl-line.el --- highlight the current line
 
-;; Copyright (C) 1998, 2000, 2001, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000, 2001, 2002, 2003, 2004,
+;;   2005 Free Software Foundation, Inc.
 
 ;; Author:  Dave Love <fx@gnu.org>
 ;; Maintainer: FSF
@@ -21,8 +22,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -53,6 +54,14 @@
 ;; selected window.  (It does so rather than keeping track of changes
 ;; in the selected window).
 
+;; You could make variable `global-hl-line-mode' buffer-local and set
+;; it to nil to avoid highlighting specific buffers, when the global
+;; mode is used.
+
+;; In default whole the line is highlighted. The range of highlighting
+;; can be changed by defining an appropriate function as the
+;; buffer-local value of `hl-line-range-function'.
+
 ;;; Code:
 
 (defgroup hl-line nil
@@ -71,9 +80,18 @@ Otherwise Hl-Line mode will highlight only in the selected
 window.  Setting this variable takes effect the next time you use
 the command `hl-line-mode' to turn Hl-Line mode on."
   :type 'boolean
-  :version "21.4"
+  :version "22.1"
   :group 'hl-line)
 
+(defvar hl-line-range-function nil
+  "If non-nil, function to call to return highlight range.
+The function of no args should return a cons cell; its car value
+is the beginning position of highlight and its cdr value is the
+end position of highlight in the buffer.
+It should return nil if there's no region to be highlighted.
+
+This variable is expected to be made buffer-local by modes.")
+
 (defvar hl-line-overlay nil
   "Overlay used by Hl-Line mode to highlight the current line.")
 (make-variable-buffer-local 'hl-line-overlay)
@@ -96,7 +114,7 @@ When `hl-line-sticky-flag' is nil, Hl-Line mode highlights the
 line about point in the selected window only.  In this case, it
 uses the function `hl-line-unhighlight' on `pre-command-hook' in
 addition to `hl-line-highlight' on `post-command-hook'."
-  nil nil nil
+  :group 'hl-line
   (if hl-line-mode
       (progn
         ;; In case `kill-all-local-variables' is called.
@@ -120,8 +138,7 @@ addition to `hl-line-highlight' on `post-command-hook'."
           (overlay-put hl-line-overlay 'face hl-line-face))
         (overlay-put hl-line-overlay
                      'window (unless hl-line-sticky-flag (selected-window)))
-        (move-overlay hl-line-overlay
-                      (line-beginning-position) (line-beginning-position 2)))
+	(hl-line-move hl-line-overlay))
     (hl-line-unhighlight)))
 
 (defun hl-line-unhighlight ()
@@ -154,14 +171,30 @@ Global-Hl-Line mode uses the functions `global-hl-line-unhighlight' and
         (setq global-hl-line-overlay (make-overlay 1 1)) ; to be moved
         (overlay-put global-hl-line-overlay 'face hl-line-face))
       (overlay-put global-hl-line-overlay 'window (selected-window))
-      (move-overlay global-hl-line-overlay
-                    (line-beginning-position) (line-beginning-position 2)))))
+      (hl-line-move global-hl-line-overlay))))
 
 (defun global-hl-line-unhighlight ()
   "Deactivate the Global-Hl-Line overlay on the current line."
   (if global-hl-line-overlay
       (delete-overlay global-hl-line-overlay)))
 
+(defun hl-line-move (overlay)
+  "Move the hl-line-mode overlay.
+If `hl-line-range-function' is non-nil, move the OVERLAY to the position
+where the function returns. If `hl-line-range-function' is nil, fill
+the line including the point by OVERLAY."
+  (let (tmp b e)
+    (if hl-line-range-function
+	(setq tmp (funcall hl-line-range-function)
+	      b   (car tmp)
+	      e   (cdr tmp))
+      (setq tmp t
+	    b (line-beginning-position)
+	    e (line-beginning-position 2)))
+    (if tmp
+	(move-overlay overlay b e)
+      (move-overlay overlay 1 1))))
+
 (provide 'hl-line)
 
 ;;; arch-tag: ac806940-0876-4959-8c89-947563ee2833