ruler support in hexl mode

[Masatake YAMATO]

I've added a ruler to hexl mode.
Please, review the patch.

Masatake YAMATO

2004-03-05  Masatake YAMATO  <address@hidden>

        * hexl.el (top-level): Add ruler support in hexl-mode.
        Require ruler.el. 
        (hexl-follow-line, hexl-use-ruler)
        (hexl-use-face-on-address-area, hexl-address-area-face)
        (hexl-use-face-on-ascii-area, hexl-ascii-area-face): 
        New customizable variables.
        (hexl-mode-old-header-line-format): New internal variable.
        (hexl-line-overlay): New internal variable.
        (hexl-mode-header-line-format): New constant.
        (hexl-mode): Store old `header-line-format' and set
        new value(ruler) to it. Turn on `hexl-follow-line'.
        (hexl-mode-exit): remove `hexl-follow-line-find' from
        `post-command-hook'. Clear `hexl-line-overlay'.
        (hexl-mode-exit): Restore old `header-line-format'.
        (hexlify-buffer): Put faces on hexl address area and 
        ascii area.
        (hexl-follow-line): New function.
        (hexl-follow-line-find): New function.
        (hexl-mode-ruler): New function.

cvs diff: warning: unrecognized response `access control disabled, clients can 
connect from any host' from cvs server
Index: lisp/hexl.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/hexl.el,v
retrieving revision 1.84
diff -u -r1.84 hexl.el
--- lisp/hexl.el        4 Mar 2004 18:19:18 -0000       1.84
+++ lisp/hexl.el        5 Mar 2004 05:26:29 -0000
@@ -43,6 +43,7 @@
 ;;; Code:
 
 (require 'eldoc)
+(require 'ruler-mode)
 
 ;;
 ;; vars here
@@ -78,6 +79,34 @@
   :group 'hexl
   :version "20.3")
 
+(defcustom hexl-follow-line t
+  "If non-nil then highlight the line address corresponding to point."
+  :type 'boolean
+  :group 'hexl)
+
+(defcustom hexl-use-ruler t
+  "If non-nil then show the ruler for hexl mode."
+  :type 'boolean
+  :group 'hexl)
+
+(defcustom hexl-use-face-on-address-area t
+  "If non-nil then put `hexl-address-area-face' on adderss area of hexl-mode 
buffer."
+  :type 'face
+  :group 'hexl)
+
+(defface hexl-address-area-face
+  '((t (:inherit header-line)))
+  "Face used in address are of hexl-mode buffer.")
+
+(defcustom hexl-use-face-on-ascii-area t
+  "If non-nil then put `hexl-ascii-area-face' on ascii area of hexl-mode 
buffer."
+  :type 'face
+  :group 'hexl)
+
+(defface hexl-ascii-area-face
+  '((t (:inherit header-line)))
+  "Face used in ascii are of hexl-mode buffer.")
+
 (defvar hexl-max-address 0
   "Maximum offset into hexl buffer.")
 
@@ -89,11 +118,20 @@
 (defvar hexl-mode-old-isearch-search-fun-function)
 (defvar hexl-mode-old-require-final-newline)
 (defvar hexl-mode-old-syntax-table)
+(defvar hexl-mode-old-header-line-format)
 
 (defvar hexl-ascii-overlay nil
   "Overlay used to highlight ASCII element corresponding to current point.")
 (make-variable-buffer-local 'hexl-ascii-overlay)
 
+(defvar hexl-line-overlay nil
+  "Overlay used to highlight the address of line corresponding to current 
point.")
+(make-variable-buffer-local 'hexl-line-overlay)
+
+(defconst hexl-mode-header-line-format
+  '(:eval (hexl-mode-ruler))
+  "`header-line-format' used in hexl mode.")
+
 ;; routines
 
 (put 'hexl-mode 'mode-class 'special)
@@ -245,8 +283,13 @@
     (eldoc-remove-command "hexl-save-buffer" 
                          "hexl-current-address")
 
-    (if hexl-follow-ascii (hexl-follow-ascii 1)))
-  (run-hooks 'hexl-mode-hook))
+    (make-variable-buffer-local 'hexl-mode-old-header-line-format)
+    (setq hexl-mode-old-header-line-format header-line-format)
+    (setq header-line-format hexl-mode-header-line-format)
+
+    (if hexl-follow-ascii (hexl-follow-ascii 1))
+    (if hexl-follow-line  (hexl-follow-line 1))
+  (run-hooks 'hexl-mode-hook)))
 
 
 (defun hexl-isearch-search-function ()
@@ -333,7 +376,10 @@
   (remove-hook 'after-revert-hook 'hexl-after-revert-hook t)
   (remove-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer t)
   (remove-hook 'post-command-hook 'hexl-follow-ascii-find t)
+  (remove-hook 'post-command-hook 'hexl-follow-line-find t)
+
   (setq hexl-ascii-overlay nil)
+  (setq hexl-line-overlay nil)
 
   (setq require-final-newline hexl-mode-old-require-final-newline)
   (setq mode-name hexl-mode-old-mode-name)
@@ -341,6 +387,7 @@
   (use-local-map hexl-mode-old-local-map)
   (set-syntax-table hexl-mode-old-syntax-table)
   (setq major-mode hexl-mode-old-major-mode)
+  (setq header-line-format hexl-mode-old-header-line-format)
   (force-mode-line-update))
 
 (defun hexl-maybe-dehexlify-buffer ()
@@ -648,6 +695,17 @@
     (apply 'call-process-region (point-min) (point-max)
           (expand-file-name hexl-program exec-directory)
           t t nil (split-string hexl-options))
+    (save-excursion
+      (when hexl-use-face-on-address-area
+       (goto-char (point-min))
+       (while (re-search-forward "^[0-9a-f]\\{8\\}:" nil t)
+         (put-text-property (match-beginning 0) (match-end 0)
+                            'face 'hexl-address-area-face)))
+      (goto-char (point-min))
+      (when hexl-use-face-on-ascii-area
+       (while (re-search-forward " \\( .+$\\)" nil t)
+         (put-text-property (match-beginning 1) (match-end 1) 
+                            'face 'hexl-ascii-area-face))))
     (if (> (point) (hexl-address-to-marker hexl-max-address))
        (hexl-goto-address hexl-max-address))))
 
@@ -865,6 +923,34 @@
            (remove-hook 'post-command-hook 'hexl-follow-ascii-find t)
            )))))
 
+(defun hexl-follow-line (&optional arg)
+  "Toggle following line address in Hexl buffers.
+With prefix ARG, turn on following if and only if ARG is positive.
+When following is enabled, the line address corresponding to the
+element under the point is highlighted.
+Customize the variable `hexl-follow-line' to disable this feature."
+  (interactive "P")
+  (let ((on-p (if arg
+                 (> (prefix-numeric-value arg) 0)
+              (not hexl-line-overlay))))
+
+    (if on-p
+      ;; turn it on
+      (if (not hexl-line-overlay)
+         (progn
+           (setq hexl-line-overlay (make-overlay 1 1)
+                 hexl-follow-line t)
+           (overlay-put hexl-line-overlay 'face 'highlight)
+           (add-hook 'post-command-hook 'hexl-follow-line-find nil t)))
+      ;; turn it off
+      (if hexl-line-overlay
+         (progn
+           (delete-overlay hexl-line-overlay)
+           (setq hexl-line-overlay nil
+                 hexl-follow-line nil)
+           (remove-hook 'post-command-hook 'hexl-follow-line-find t)
+           )))))
+
 (defun hexl-follow-ascii-find ()
   "Find and highlight the ASCII element corresponding to current point."
   (let ((pos (+ 51
@@ -872,6 +958,64 @@
                (mod (hexl-current-address) 16))))
     (move-overlay hexl-ascii-overlay pos (1+ pos))
     ))
+
+(defun hexl-follow-line-find ()
+  "Find and highlight the line address corresponding to current point."
+  (move-overlay hexl-line-overlay
+               (line-beginning-position)
+               (+ (line-beginning-position) 8)))
+
+;; ruler
+
+;; This function is derived from `ruler-mode-ruler' in ruler-mode.el.
+(defun hexl-mode-ruler ()
+  "Return a string ruler for hexl mode."
+  (when hexl-use-ruler
+    (let* ((fullw (ruler-mode-full-window-width))
+          (w     (window-width))
+          (m     (window-margins))
+          (lsb   (ruler-mode-left-scroll-bar-cols))
+          (lf    (ruler-mode-left-fringe-cols))
+          (lm    (or (car m) 0))
+          (ruler (make-string fullw ?\ ))
+          (o     (+ lsb lf lm))
+          (x o)
+          (highlight (mod (hexl-current-address) 16)))
+      ;; "87654321"
+      (do ((i 8 (1- i)))
+         ((= i 0))
+       (aset ruler x (aref (number-to-string i) 0))
+       (setq x (1+ x)))
+      ;; "87654321  "
+      (setq x (+ x 2))                 ; ": "
+      ;; "87654321  0011 2233 4455 6677 8899 aabb ccdd eeff"
+      (do* ((i 0 (1+ i))
+           (c (format "%x" i) (format "%x" i)))
+         ((= i 16))
+       (aset ruler x (aref c 0))
+       (setq x (1+ x))
+       (aset ruler x (aref c 0))
+       (setq x (1+ x))
+       (if (= highlight i)
+           (put-text-property (- x 2) x 
+                              'face 'highlight
+                              ruler))
+       (when (= (mod i 2) 1) 
+         (aset ruler x ?\ )
+         (setq x (1+ x))))
+      ;; "87654321  0011 2233 4455 6677 8899 aabb ccdd eeff "
+      (setq x (1+ x))                  ; " "
+      ;; "87654321  0011 2233 4455 6677 8899 aabb ccdd eeff  0123456789abcdef"
+      (do* ((i 0 (1+ i))
+           (c (format "%x" i) (format "%x" i)))
+         ((= i 16))
+       (aset ruler x (aref c 0))
+       (setq x (1+ x))
+       (if (= highlight i)
+           (put-text-property (1- x) x 
+                              'face 'highlight
+                              ruler)))
+      ruler)))
 
 ;; startup stuff.