Re: ruler support in hexl mode

[Masatake YAMATO]

Based on Stefan and Kim's suggestions, I have revised the patch.

I've moved the essential functions(`scroll-bar-columns' and `fringe-columns') 
in ruler-mode.el to frame.el and fringe.el and use new functions in 
ruler-mode.el and hexl.el.

Index: lisp/ruler-mode.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/ruler-mode.el,v
retrieving revision 1.17
diff -u -r1.17 ruler-mode.el
--- lisp/ruler-mode.el  20 Oct 2003 23:27:52 -0000      1.17
+++ lisp/ruler-mode.el  12 Mar 2004 06:01:27 -0000
@@ -107,7 +107,9 @@
 
 ;;; Code:
 (eval-when-compile
-  (require 'wid-edit))
+  (require 'wid-edit)
+  (require 'frame)
+  (require 'fringe))
 
 (defgroup ruler-mode nil
   "Display a ruler in the header line."
@@ -298,42 +300,21 @@
   "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."
Index: lisp/hexl.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/hexl.el,v
retrieving revision 1.85
diff -u -r1.85 hexl.el
--- lisp/hexl.el        9 Mar 2004 01:25:27 -0000       1.85
+++ lisp/hexl.el        12 Mar 2004 06:01:27 -0000
@@ -42,7 +42,11 @@
 
 ;;; Code:
 
-(require 'eldoc)
+(eval-when-compile
+  (require 'frame)
+  (require 'fringe)
+  (require 'eldoc)
+  (require 'hl-line))
 
 ;;
 ;; vars here
@@ -78,6 +82,33 @@
   :group 'hexl
   :version "20.3")
 
+(defcustom hexl-follow-line t
+  "If non-nil then turn `hl-line-mode' on."
+  :type 'boolean
+  :group 'hexl)
+
+(defcustom hexl-use-ruler t
+  "If non-nil then show the ruler for hexl mode."
+  :type 'boolean
+  :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)
+
+(defface hexl-ascii-overlay
+  ;; Definition borrowed from vcursor.el.
+  '((((class color)) (:foreground "blue" :background "cyan" :underline t))
+    (t (:inverse-video t :underline t)))
+  "Face for the overlay in ascii area of hexl mode buffer."
+  :group 'hexl)
+
 (defvar hexl-max-address 0
   "Maximum offset into hexl buffer.")
 
@@ -89,11 +120,16 @@
 (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)
 
+(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,7 +281,11 @@
     (eldoc-remove-command "hexl-save-buffer" 
                          "hexl-current-address")
 
-    (if hexl-follow-ascii (hexl-follow-ascii 1)))
+    (set (make-local-variable '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))
 
 
@@ -341,6 +381,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 +689,15 @@
     (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))))
 
@@ -854,7 +904,7 @@
          (progn
            (setq hexl-ascii-overlay (make-overlay 1 1)
                  hexl-follow-ascii t)
-           (overlay-put hexl-ascii-overlay 'face 'highlight)
+           (overlay-put hexl-ascii-overlay 'face 'hexl-ascii-overlay)
            (add-hook 'post-command-hook 'hexl-follow-ascii-find nil t)))
       ;; turn it off
       (if hexl-ascii-overlay
@@ -865,6 +915,20 @@
            (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-follow-line))))
+
+    (setq hexl-follow-line on-p)
+    (hl-line-mode (if on-p 1 -1))))
+
 (defun hexl-follow-ascii-find ()
   "Find and highlight the ASCII element corresponding to current point."
   (let ((pos (+ 51
@@ -872,6 +936,38 @@
                (mod (hexl-current-address) 16))))
     (move-overlay hexl-ascii-overlay pos (1+ pos))
     ))
+
+(defun hexl-mode-ruler ()
+  "Return a string ruler for hexl mode."
+  (when hexl-use-ruler
+    (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.
 
Index: lisp/fringe.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/fringe.el,v
retrieving revision 1.10
diff -u -r1.10 fringe.el
--- lisp/fringe.el      8 Feb 2004 23:33:16 -0000       1.10
+++ lisp/fringe.el      12 Mar 2004 06:01:27 -0000
@@ -218,6 +218,17 @@
    (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
Index: lisp/frame.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/frame.el,v
retrieving revision 1.206
diff -u -r1.206 frame.el
--- lisp/frame.el       29 Dec 2003 19:17:24 -0000      1.206
+++ lisp/frame.el       12 Mar 2004 06:01:27 -0000
@@ -1215,6 +1215,22 @@
   :group 'scrolling)
 (defvaralias 'automatic-hscrolling 'auto-hscroll-mode)
 
+(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))))
 
 ;; Blinking cursor