2004-03-15 Masatake YAMATO <jet@gyve.org>

	* hl-line.el (hl-line-range-function): New variable.
	(hl-line-move): New function.
	(global-hl-line-highlight): Use `hl-line-move'.
	(hl-line-highlight): Ditto.

	* scroll-bar.el (scroll-bar-columns): New function derived from
	ruler-mode.el.

	* fringe.el (fringe-columns): New function derived from
	ruler-mode.el.

	* ruler-mode.el (top-level): Require scroll-bar and fringe.
	(ruler-mode-left-fringe-cols)
	(ruler-mode-right-fringe-cols): Use `fringe-columns'.
	(ruler-mode-right-scroll-bar-cols)
	(ruler-mode-left-scroll-bar-cols): Use `scroll-bar-columns'.
	(ruler-mode-ruler-function): New variable.
	(ruler-mode-header-line-format): Call `ruler-mode-ruler-function'
	if the value for `ruler-mode-ruler-function'is given.

	* hexl.el (hexl-mode-hook): Make the hook customizable.
	(hexl-address-area, hexl-ascii-area, hexl-ascii-cursor): New
	customize variables.
	(hexlify-buffer): Put font-lock-faces on the address area and
	the ascii area.
	(hexl-activate-ruler): New function.
	(hexl-follow-line): New function.
	(hexl-highlight-line-range): New function.
	(hexl-mode-ruler): New function.

6 files changed, 193 insertions, 31 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index fe1b7db508e..b28512af321 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,35 @@
+2004-03-15  Masatake YAMATO  <jet@gyve.org>
+
+        * hl-line.el (hl-line-range-function): New variable.
+        (hl-line-move): New function.
+        (global-hl-line-highlight): Use `hl-line-move'.
+        (hl-line-highlight): Ditto.
+
+        * scroll-bar.el (scroll-bar-columns): New function derived from
+        ruler-mode.el.
+
+        * fringe.el (fringe-columns): New function derived from
+        ruler-mode.el.
+
+        * ruler-mode.el (top-level): Require scroll-bar and fringe.
+        (ruler-mode-left-fringe-cols)
+        (ruler-mode-right-fringe-cols): Use `fringe-columns'.
+        (ruler-mode-right-scroll-bar-cols)
+        (ruler-mode-left-scroll-bar-cols): Use `scroll-bar-columns'.
+        (ruler-mode-ruler-function): New variable.
+        (ruler-mode-header-line-format): Call `ruler-mode-ruler-function'
+        if the value for `ruler-mode-ruler-function'is given.
+
+        * hexl.el (hexl-mode-hook): Make the hook customizable.
+        (hexl-address-area, hexl-ascii-area, hexl-ascii-cursor): New 
+        customize variables.
+        (hexlify-buffer): Put font-lock-faces on the address area and 
+        the ascii area.
+        (hexl-activate-ruler): New function.
+        (hexl-follow-line): New function.
+        (hexl-highlight-line-range): New function.
+        (hexl-mode-ruler): New function.
+
 2004-03-12  Jesper Harder  <harder@ifa.au.dk>
 
         * info-look.el (info-lookup): Reuse an existing Info window.
diff --git a/lisp/fringe.el b/lisp/fringe.el
index ab7709332f5..f52ecdf64d2 100644
--- a/lisp/fringe.el
+++ b/lisp/fringe.el
@@ -218,6 +218,17 @@ default appearance of fringes on all frames, see the command
    (list (cons 'left-fringe (if (consp mode) (car mode) mode))
          (cons 'right-fringe (if (consp mode) (cdr mode) mode)))))
 
+(defsubst fringe-columns (side &optional real)
+  "Return the width, measured in columns, of the fringe area on SIDE.
+If optional argument REAL is non-nil, return a real floating point
+number instead of a rounded integer value.
+SIDE must be the symbol `left' or `right'."
+  (funcall (if real '/ 'ceiling)
+           (or (funcall (if (eq side 'left) 'car 'cadr)
+                        (window-fringes))
+               0)
+           (float (frame-char-width))))
+  
 (provide 'fringe)
 
 ;;; arch-tag: 6611ef60-0869-47ed-8b93-587ee7d3ff5d
diff --git a/lisp/hexl.el b/lisp/hexl.el
index 9fd21824f26..66aceeaee71 100644
--- a/lisp/hexl.el
+++ b/lisp/hexl.el
@@ -78,6 +78,22 @@ Quoting cannot be used, so the arguments cannot themselves contain spaces."
   :group 'hexl
   :version "20.3")
 
+(defcustom hexl-mode-hook '(hexl-follow-line hexl-activate-ruler)
+  "Normal hook run when entering Hexl mode."
+  :type 'hook
+  :options '(hexl-follow-line hexl-activate-ruler turn-on-eldoc-mode)
+  :group 'hexl)
+
+(defface hexl-address-area
+  '((t (:inherit header-line)))
+  "Face used in address are of hexl-mode buffer."
+  :group 'hexl)
+
+(defface hexl-ascii-area
+  '((t (:inherit header-line)))
+  "Face used in ascii are of hexl-mode buffer."
+  :group 'hexl)
+
 (defvar hexl-max-address 0
   "Maximum offset into hexl buffer.")
 
@@ -648,6 +664,15 @@ This discards the buffer's undo information."
     (apply 'call-process-region (point-min) (point-max)
            (expand-file-name hexl-program exec-directory)
            t t nil (split-string hexl-options))
+    (save-excursion
+      (goto-char (point-min))
+      (while (re-search-forward "^[0-9a-f]+:" nil t)
+        (put-text-property (match-beginning 0) (match-end 0)
+                           'font-lock-face 'hexl-address-area))
+      (goto-char (point-min))
+      (while (re-search-forward "  \\(.+$\\)" nil t)
+        (put-text-property (match-beginning 1) (match-end 1) 
+                           'font-lock-face 'hexl-ascii-area)))
     (if (> (point) (hexl-address-to-marker hexl-max-address))
         (hexl-goto-address hexl-max-address))))
 
@@ -865,6 +890,32 @@ Customize the variable `hexl-follow-ascii' to disable this feature."
             (remove-hook 'post-command-hook 'hexl-follow-ascii-find t)
             )))))
 
+(defun hexl-activate-ruler ()
+  "Activate `ruler-mode'"
+  (require 'ruler-mode)
+  (set (make-local-variable 'ruler-mode-ruler-function) 
+       'hexl-mode-ruler)
+  (ruler-mode 1))
+
+(defun hexl-follow-line ()
+  "Activate `hl-line-mode'"
+  (require 'frame)
+  (require 'fringe)
+  (require 'hl-line)
+  (set (make-local-variable 'hl-line-range-function)
+       'hexl-highlight-line-range)
+  (set (make-local-variable 'hl-line-face) 
+       'highlight)
+  (hl-line-mode 1))
+
+(defun hexl-highlight-line-range ()
+  "Return the range of address area for the point.
+This function is assumed to be used as call back function for `hl-line-mode'."
+  (cons
+   (line-beginning-position)
+   ;; 9 stands for (length "87654321:")
+   (+ (line-beginning-position) 9)))
+
 (defun hexl-follow-ascii-find ()
   "Find and highlight the ASCII element corresponding to current point."
   (let ((pos (+ 51
@@ -873,6 +924,37 @@ Customize the variable `hexl-follow-ascii' to disable this feature."
     (move-overlay hexl-ascii-overlay pos (1+ pos))
     ))
 
+(defun hexl-mode-ruler ()
+  "Return a string ruler for hexl mode."
+  (let* ((highlight (mod (hexl-current-address) 16))
+         (s "87654321  0011 2233 4455 6677 8899 aabb ccdd eeff  0123456789abcdef")
+         (pos 0)
+         (spaces (+ (scroll-bar-columns 'left) 
+                    (fringe-columns 'left)
+                    (or (car (window-margins)) 0))))
+    (set-text-properties 0 (length s) nil s)
+    ;; Turn spaces in the header into stretch specs so they work
+    ;; regardless of the header-line face.
+    (while (string-match "[ \t]+" s pos)
+      (setq pos (match-end 0))
+      (put-text-property (match-beginning 0) pos 'display
+                         ;; Assume fixed-size chars
+                         `(space :align-to (+ (scroll-bar . left)
+                                              left-fringe left-margin
+                                              ,pos))
+                         s))
+    ;; Highlight the current column.
+    (put-text-property (+ 10 (/ (* 5 highlight) 2))
+                       (+ 12 (/ (* 5 highlight) 2))
+                       'face 'highlight s)
+    ;; Highlight the current ascii column
+    (put-text-property (+ 12 39 highlight) (+ 12 40 highlight)
+                       'face 'highlight s)
+    ;; Add the leading space.
+    (concat (propertize (make-string (floor spaces) ? )
+                        'display `(space :width ,spaces))
+            s)))
+
 ;; startup stuff.
 
 (if hexl-mode-map
diff --git a/lisp/hl-line.el b/lisp/hl-line.el
index 58921aaa58a..5ed334f4049 100644
--- a/lisp/hl-line.el
+++ b/lisp/hl-line.el
@@ -57,6 +57,10 @@
 ;; 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
@@ -78,6 +82,15 @@ the command `hl-line-mode' to turn Hl-Line mode on."
   :version "21.4"
   :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)
@@ -124,8 +137,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 ()
@@ -158,14 +170,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
diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el
index 18fdcddd507..d6c205a23b4 100644
--- a/lisp/ruler-mode.el
+++ b/lisp/ruler-mode.el
@@ -94,6 +94,9 @@
 ;; WARNING: To keep ruler graduations aligned on text columns it is
 ;; important to use the same font family and size for ruler and text
 ;; areas.
+;;
+;; You can override the ruler format by defining an appropriate 
+;; function as the buffer-local value of `ruler-mode-ruler-function'.
 
 ;; Installation
 ;;
@@ -108,6 +111,8 @@
 ;;; Code:
 (eval-when-compile
   (require 'wid-edit))
+(require 'scroll-bar)
+(require 'fringe)
 
 (defgroup ruler-mode nil
   "Display a ruler in the header line."
@@ -298,42 +303,21 @@ or remove a tab stop.  \\[ruler-mode-toggle-show-tab-stops] or
   "Return the width, measured in columns, of the left fringe area.
 If optional argument REAL is non-nil, return a real floating point
 number instead of a rounded integer value."
-  (funcall (if real '/ 'ceiling)
-           (or (car (window-fringes)) 0)
-           (float (frame-char-width))))
+  (fringe-columns 'left real))
 
 (defsubst ruler-mode-right-fringe-cols (&optional real)
   "Return the width, measured in columns, of the right fringe area.
 If optional argument REAL is non-nil, return a real floating point
 number instead of a rounded integer value."
-  (funcall (if real '/ 'ceiling)
-            (or (nth 1 (window-fringes)) 0)
-            (float (frame-char-width))))
-
-(defun ruler-mode-scroll-bar-cols (side)
-  "Return the width, measured in columns, of the vertical scrollbar on SIDE.
-SIDE must be the symbol `left' or `right'."
-  (let* ((wsb   (window-scroll-bars))
-         (vtype (nth 2 wsb))
-         (cols  (nth 1 wsb)))
-    (cond
-     ((not (memq side '(left right)))
-      (error "`left' or `right' expected instead of %S" side))
-     ((and (eq vtype side) cols))
-     ((eq (frame-parameter nil 'vertical-scroll-bars) side)
-      ;; nil means it's a non-toolkit scroll bar, and its width in
-      ;; columns is 14 pixels rounded up.
-      (ceiling (or (frame-parameter nil 'scroll-bar-width) 14)
-               (frame-char-width)))
-     (0))))
+  (fringe-columns 'right real))
 
 (defmacro ruler-mode-right-scroll-bar-cols ()
   "Return the width, measured in columns, of the right vertical scrollbar."
-  '(ruler-mode-scroll-bar-cols 'right))
+  '(scroll-bar-columns 'right))
 
 (defmacro ruler-mode-left-scroll-bar-cols ()
   "Return the width, measured in columns, of the left vertical scrollbar."
-  '(ruler-mode-scroll-bar-cols 'left))
+  '(scroll-bar-columns 'left))
 
 (defsubst ruler-mode-full-window-width ()
   "Return the full width of the selected window."
@@ -568,9 +552,17 @@ START-EVENT is the mouse click event."
   "Hold previous value of `header-line-format'.")
 (make-variable-buffer-local 'ruler-mode-header-line-format-old)
 
+(defvar ruler-mode-ruler-function nil
+  "If non-nil, function to call to return ruler string.
+This variable is expected to be made buffer-local by modes.")
+
 (defconst ruler-mode-header-line-format
-  '(:eval (ruler-mode-ruler))
-  "`header-line-format' used in ruler mode.")
+  '(:eval (funcall (if ruler-mode-ruler-function
+                       ruler-mode-ruler-function
+                     'ruler-mode-ruler)))
+  "`header-line-format' used in ruler mode.
+If the non-nil value for ruler-mode-ruler-function is given, use it.
+Else use `ruler-mode-ruler' is used as default value.")
 
 ;;;###autoload
 (define-minor-mode ruler-mode
diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el
index a2f2d22da5d..2d2921e9fc9 100644
--- a/lisp/scroll-bar.el
+++ b/lisp/scroll-bar.el
@@ -54,6 +54,23 @@ that scroll bar position."
   ;; with a large scroll bar portion can easily overflow a lisp int.
   (truncate (/ (* (float (car num-denom)) whole) (cdr num-denom))))
 
+(defun scroll-bar-columns (side)
+  "Return the width, measured in columns, of the vertical scrollbar on SIDE.
+SIDE must be the symbol `left' or `right'."
+  (let* ((wsb   (window-scroll-bars))
+         (vtype (nth 2 wsb))
+         (cols  (nth 1 wsb)))
+    (cond
+     ((not (memq side '(left right)))
+      (error "`left' or `right' expected instead of %S" side))
+     ((and (eq vtype side) cols))
+     ((eq (frame-parameter nil 'vertical-scroll-bars) side)
+      ;; nil means it's a non-toolkit scroll bar, and its width in
+      ;; columns is 14 pixels rounded up.
+      (ceiling (or (frame-parameter nil 'scroll-bar-width) 14)
+               (frame-char-width)))
+     (0))))
+
 
 ;;;; Helpful functions for enabling and disabling scroll bars.