ruler support in hexl mode

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  <jet@gyve.org>

	* 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.

Re: ruler support in hexl mode

[Stefan Monnier]

> +(defcustom hexl-follow-line t
> +  "If non-nil then highlight the line address corresponding to point."
> +  :type 'boolean
> +  :group 'hexl)

Any reason why you do not simply use hl-line-mode ?
Or, better yet, let the user select hl-line-mode if he wants it?

> +(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)
> +(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)

You can probably just remove these variables and place the faces on the
`font-lock-face' property, so the user can use M-x global-font-lock-mode
to turn highlighting on/off.

> @@ -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)

That should be
   (set (make-local-variable 'hexl-mode-old-header-line-format) header-line-format)
`make-variable-buffer-local' should almost never be called from inside
a function.

> +	(while (re-search-forward "^[0-9a-f]\\{8\\}:" nil t)

I'd use `+' rather than `\\{8\\}' because it's shorter, easier to read,
more efficient, and most importantly future-proof (for very large files).

> +	  (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))))

Why do you put the face property on the space before the actual "ascii" data?

> +;; 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 ?\ ))

We really need to move this out of ruler-mode into frame.el or some other
"global" file.  And to give it a clean interface so its implementation can
be improved later.

> +	   (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)))

Isn't this always building the exact same string, except for the size
(which really does not need to depend on the window's width), the leading
space (to align it), and the highlighting of the current column?

Couldn't we just do (100% untested code, inspired from buff-menu.el):

  (let ((spaces (+ lsb lf lm))
        (s "87654321  0011 2233 4455 6677 8899 aabb ccdd eeff  0123456789abcdef")
        (pos 0))
    ;; 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 ,(+ spaces pos))
                         s))
    ;; Highlight the current column.
    (put-text-property (+ 10 (/ (* 5 highlight) 2))
                       (+ 12 (/ (* 5 highlight) 2))
                       'face 'highlight s)
    ;; Add the leading space.
    (concat (propertize (make-string (floor spaces) ? )
                        'display `(space :width ,spaces))
            s))

Note that the use of the display property also allows us to deal with
fractional sizes, although lsb and lf don't take advantage of it yet.
 
Also I wish we could put some more useful info up there, but admittedly,
I can't think of any.


        Stefan

Re: ruler support in hexl mode

[Miles Bader]

On Fri, Mar 05, 2004 at 02:29:15PM +0900, Masatake YAMATO wrote:
> +(defface hexl-address-area-face
> +(defface hexl-ascii-area-face

Please do not use a `-face' suffix for face names -- it's unnecessary and
redundant (faces have their own namespace).  These faces should be called
just `hexl-address-area' and `hexl-ascii-area'.

Thanks,

-Miles
-- 
`Life is a boundless sea of bitterness'

Re: ruler support in hexl mode

[Masatake YAMATO]

> > +(defcustom hexl-follow-line t
> > +  "If non-nil then highlight the line address corresponding to point."
> > +  :type 'boolean
> > +  :group 'hexl)
> 
> Any reason why you do not simply use hl-line-mode ?
> Or, better yet, let the user select hl-line-mode if he wants it?

Using hl-line-mode is good idea. However, hl-line-mode hides the
highlighted character associated with the point in ascii area. I will
put other face than highlight on the character associated with the
point.

> > +;; 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 ?\ ))
> 
> We really need to move this out of ruler-mode into frame.el or some other
> "global" file.  And to give it a clean interface so its implementation can
> be improved later.

Are You talking about each functions or generic ruler mechanism?

About former, I have inspect ruler-mode.el again.

    (let* ((w     (window-width))
           (m     (window-margins))
           (lsb   (ruler-mode-left-scroll-bar-cols))
           (lf    (ruler-mode-left-fringe-cols t))
           (lm    (or (car m) 0))
           (rsb   (ruler-mode-right-scroll-bar-cols))
           (rf    (ruler-mode-right-fringe-cols t))
           (rm    (or (cdr m) 0))
           (ruler (make-string w ruler-mode-basic-graduation-char))
           (i     0)
           (j     (window-hscroll))
           k c l1 l2 r2 r1 h1 h2 f1 f2)

Next two functions should be in "global" file:
ruler-mode-left-scroll-bar-cols and ruler-mode-left-fringe-cols.
I think these should be renamed to  scroll-bar-columns and 
fringe-columns. How do you think?

> > +	   (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)))
> 
> Isn't this always building the exact same string, except for the size
> (which really does not need to depend on the window's width), the leading
> space (to align it), and the highlighting of the current column?
> 
> Couldn't we just do (100% untested code, inspired from buff-menu.el):
...

After modifying a bit, your code works fine.

Masatake YAMATO

Re: ruler support in hexl mode

[Masatake YAMATO]

[resending]

> > +(defcustom hexl-follow-line t
> > +  "If non-nil then highlight the line address corresponding to point."
> > +  :type 'boolean
> > +  :group 'hexl)
> 
> Any reason why you do not simply use hl-line-mode ?
> Or, better yet, let the user select hl-line-mode if he wants it?

Using hl-line-mode is good idea. However, hl-line-mode hides the
highlighted character associated with the point in ascii area. I will
put other face than highlight on the character associated with the
point.

> > +;; 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 ?\ ))
> 
> We really need to move this out of ruler-mode into frame.el or some other
> "global" file.  And to give it a clean interface so its implementation can
> be improved later.

Are You talking about each functions or generic ruler mechanism?

About former, I have inspect ruler-mode.el again.

    (let* ((w     (window-width))
           (m     (window-margins))
           (lsb   (ruler-mode-left-scroll-bar-cols))
           (lf    (ruler-mode-left-fringe-cols t))
           (lm    (or (car m) 0))
           (rsb   (ruler-mode-right-scroll-bar-cols))
           (rf    (ruler-mode-right-fringe-cols t))
           (rm    (or (cdr m) 0))
           (ruler (make-string w ruler-mode-basic-graduation-char))
           (i     0)
           (j     (window-hscroll))
           k c l1 l2 r2 r1 h1 h2 f1 f2)

Next two functions should be in "global" file:
ruler-mode-left-scroll-bar-cols and ruler-mode-left-fringe-cols.
I think these should be renamed to  scroll-bar-columns and 
fringe-columns. How do you think?

> > +	   (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)))
> 
> Isn't this always building the exact same string, except for the size
> (which really does not need to depend on the window's width), the leading
> space (to align it), and the highlighting of the current column?
> 
> Couldn't we just do (100% untested code, inspired from buff-menu.el):
...

After modifying a bit, your code works fine.

Masatake YAMATO

Re: ruler support in hexl mode

[Juanma Barranquero]

On Mon, 8 Mar 2004 16:00:06 -0500
Miles Bader <miles@gnu.org> wrote:

> Please do not use a `-face' suffix for face names -- it's unnecessary and
> redundant (faces have their own namespace).  These faces should be called
> just `hexl-address-area' and `hexl-ascii-area'.

A cursory look (find, really) on the lisp/ tree brings out 292 cases of
faces named *-face (or, in some instances, *-face*).

Time for a `make-obsolete-face' function? :)

                                                                Juanma


Buffer-menu-buffer-face
Info-title-1-face
Info-title-2-face
Info-title-3-face
Info-title-4-face
antlr-font-lock-default-face
antlr-font-lock-keyword-face
antlr-font-lock-literal-face
antlr-font-lock-ruledef-face
antlr-font-lock-ruleref-face
antlr-font-lock-syntax-face
antlr-font-lock-tokendef-face
antlr-font-lock-tokenref-face
breakpoint-disabled-bitmap-face
breakpoint-enabled-bitmap-face
c-invalid-face
calendar-today-face
change-log-acknowledgement-face
change-log-conditionals-face
change-log-date-face
change-log-email-face
change-log-file-face
change-log-function-face
change-log-list-face
change-log-name-face
compare-windows-face
cperl-array-face
cperl-hash-face
cperl-nonoverridable-face
cua-global-mark-face
cua-rectangle-face
cua-rectangle-noselect-face
custom-button-face
custom-button-pressed-face
custom-changed-face
custom-comment-face
custom-comment-tag-face
custom-documentation-face
custom-face-tag-face
custom-group-tag-face
custom-group-tag-face-1
custom-invalid-face
custom-modified-face
custom-rogue-face
custom-saved-face
custom-set-face
custom-state-face
custom-variable-button-face
custom-variable-tag-face
cvs-filename-face
cvs-handled-face
cvs-header-face
cvs-marked-face
cvs-msg-face
cvs-need-action-face
cvs-unknown-face
diary-button-face
diary-face
diff-added-face
diff-changed-face
diff-context-face
diff-file-header-face
diff-function-face
diff-header-face
diff-hunk-header-face
diff-index-face
diff-nonexistent-face
diff-removed-face
ebrowse-default-face
ebrowse-file-name-face
ebrowse-member-attribute-face
ebrowse-member-class-face
ebrowse-progress-face
ebrowse-root-class-face
ebrowse-tree-mark-face
ediff-current-diff-face-A
ediff-current-diff-face-Ancestor
ediff-current-diff-face-B
ediff-current-diff-face-C
ediff-even-diff-face-A
ediff-even-diff-face-Ancestor
ediff-even-diff-face-B
ediff-even-diff-face-C
ediff-fine-diff-face-A
ediff-fine-diff-face-Ancestor
ediff-fine-diff-face-B
ediff-fine-diff-face-C
ediff-odd-diff-face-A
ediff-odd-diff-face-Ancestor
ediff-odd-diff-face-B
ediff-odd-diff-face-C
eshell-ls-archive-face
eshell-ls-backup-face
eshell-ls-clutter-face
eshell-ls-directory-face
eshell-ls-executable-face
eshell-ls-missing-face
eshell-ls-product-face
eshell-ls-readonly-face
eshell-ls-special-face
eshell-ls-symlink-face
eshell-ls-unreadable-face
eshell-prompt-face
eshell-test-failed-face
eshell-test-ok-face
flyspell-duplicate-face
flyspell-incorrect-face
font-lock-builtin-face
font-lock-comment-face
font-lock-constant-face
font-lock-doc-face
font-lock-function-name-face
font-lock-keyword-face
font-lock-preprocessor-face
font-lock-string-face
font-lock-type-face
font-lock-variable-name-face
font-lock-warning-face
gnus-cite-attribution-face
gnus-cite-face-1
gnus-cite-face-2
gnus-cite-face-3
gnus-cite-face-4
gnus-cite-face-5
gnus-cite-face-6
gnus-cite-face-7
gnus-cite-face-8
gnus-cite-face-9
gnus-cite-face-10
gnus-cite-face-11
gnus-group-mail-1-empty-face
gnus-group-mail-1-face
gnus-group-mail-2-empty-face
gnus-group-mail-2-face
gnus-group-mail-3-empty-face
gnus-group-mail-3-face
gnus-group-mail-low-empty-face
gnus-group-mail-low-face
gnus-group-news-1-empty-face
gnus-group-news-1-face
gnus-group-news-2-empty-face
gnus-group-news-2-face
gnus-group-news-3-empty-face
gnus-group-news-3-face
gnus-group-news-4-empty-face
gnus-group-news-4-face
gnus-group-news-5-empty-face
gnus-group-news-5-face
gnus-group-news-6-empty-face
gnus-group-news-6-face
gnus-group-news-low-empty-face
gnus-group-news-low-face
gnus-header-content-face
gnus-header-from-face
gnus-header-name-face
gnus-header-newsgroups-face
gnus-header-subject-face
gnus-signature-face
gnus-splash-face
gnus-summary-cancelled-face
gnus-summary-high-ancient-face
gnus-summary-high-read-face
gnus-summary-high-ticked-face
gnus-summary-high-unread-face
gnus-summary-low-ancient-face
gnus-summary-low-read-face
gnus-summary-low-ticked-face
gnus-summary-low-unread-face
gnus-summary-normal-ancient-face
gnus-summary-normal-read-face
gnus-summary-normal-ticked-face
gnus-summary-normal-unread-face
gnus-summary-selected-face
gomoku-font-lock-O-face
gomoku-font-lock-X-face
highlight-changes-delete-face
highlight-changes-face
holiday-face
idlwave-help-link-face
idlwave-shell-bp-face
ido-first-match-face
ido-indicator-face
ido-only-match-face
ido-subdir-face
isearch-lazy-highlight-face
ld-script-location-counter-face
log-view-file-face
log-view-message-face
makefile-space-face
message-cited-text-face
message-header-cc-face
message-header-name-face
message-header-newsgroups-face
message-header-other-face
message-header-subject-face
message-header-to-face
message-header-xheader-face
message-mml-face
message-separator-face
mh-folder-body-face
mh-folder-cur-msg-face
mh-folder-cur-msg-number-face
mh-folder-date-face
mh-folder-followup-face
mh-folder-msg-number-face
mh-folder-refiled-face
mh-folder-subject-face
mh-folder-tick-face
mh-folder-to-face
mh-index-folder-face
mh-show-cc-face
mh-show-date-face
mh-show-from-face
mh-show-header-face
mh-show-to-face
mh-show-xface-face
mh-speedbar-folder-face
mh-speedbar-folder-with-unseen-messages-face
mh-speedbar-selected-folder-face
mh-speedbar-selected-folder-with-unseen-messages-face
mpuz-solved-face
mpuz-text-face
mpuz-trivial-face
mpuz-unsolved-face
ruler-mode-column-number-face
ruler-mode-comment-column-face
ruler-mode-current-column-face
ruler-mode-default-face
ruler-mode-fill-column-face
ruler-mode-fringes-face
ruler-mode-goal-column-face
ruler-mode-margins-face
ruler-mode-pad-face
ruler-mode-tab-stop-face
sgml-namespace-face
sh-heredoc-face
show-paren-match-face
show-paren-mismatch-face
show-tabs-space-face
show-tabs-tab-face
smerge-base-face
smerge-markers-face
smerge-mine-face
smerge-other-face
speedbar-button-face
speedbar-directory-face
speedbar-file-face
speedbar-highlight-face
speedbar-selected-face
speedbar-tag-face
strokes-char-face
table-cell-face
testcover-1value-face
testcover-nohits-face
tex-math-face
tex-verbatim-face
texinfo-heading-face
vhdl-font-lock-attribute-face
vhdl-font-lock-directive-face
vhdl-font-lock-enumvalue-face
vhdl-font-lock-function-face
vhdl-font-lock-prompt-face
vhdl-font-lock-reserved-words-face
vhdl-font-lock-translate-off-face
vhdl-speedbar-architecture-face
vhdl-speedbar-architecture-selected-face
vhdl-speedbar-configuration-face
vhdl-speedbar-configuration-selected-face
vhdl-speedbar-entity-face
vhdl-speedbar-entity-selected-face
vhdl-speedbar-instantiation-face
vhdl-speedbar-instantiation-selected-face
vhdl-speedbar-library-face
vhdl-speedbar-package-face
vhdl-speedbar-package-selected-face
vhdl-speedbar-subprogram-face
viper-minibuffer-emacs-face
viper-minibuffer-insert-face
viper-minibuffer-vi-face
viper-replace-overlay-face
viper-search-face
whitespace-highlight-face
widget-button-face
widget-button-pressed-face
widget-documentation-face
widget-field-face
widget-inactive-face
widget-single-line-field-face
woman-addition-face
woman-bold-face
woman-italic-face
woman-unknown-face

Re: ruler support in hexl mode

[Kim F. Storm]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

> 
> > +;; 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 ?\ ))
> 
> We really need to move this out of ruler-mode into frame.el or some other
> "global" file.  And to give it a clean interface so its implementation can
> be improved later.

You can drop all of that ruler-mode- stuff if you use the advanced
pixel-alignment form of :align-to (see xdisp.c around line 17990):

  (let ((s " 87654321  0011 2233 4455 6677 8899 aabb ccdd eeff  0123456789abcdef")
        (pos 0))
    ;; 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
                                              ,(1- pos)))
                         s))
    ;; Highlight the current column.
    (put-text-property (+ 11 (/ (* 5 highlight) 2))
                       (+ 13 (/ (* 5 highlight) 2))
                       'face 'highlight s))

> Note that the use of the display property also allows us to deal with
> fractional sizes, although lsb and lf don't take advantage of it yet.

The above code snippet does exact pixel alignment !

> Also I wish we could put some more useful info up there, but admittedly,
> I can't think of any.


-- 
Kim F. Storm <storm@cua.dk> http://www.cua.dk

Re: ruler support in hexl mode

[Stefan Monnier]

> You can drop all of that ruler-mode- stuff if you use the advanced
> pixel-alignment form of :align-to (see xdisp.c around line 17990):

Hey neat.  When was this added?

>   (let ((s " 87654321  0011 2233 4455 6677 8899 aabb ccdd eeff  0123456789abcdef")
>         (pos 0))
>     ;; 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
>                                               ,(1- pos)))
>                          s))

Note that if there's no margin (i.e. 99% of the time) this will not align
things properly on a text terminal.  This is the reason why I do
a `make-string' for the leading space: the size of the string is used
for alignment in text-terminals while the `display' prop is used otherwise.

Of course, the text-terminal display engine should ideally be improved to
understand :align-to and such things, but I won't be the one to implement it.

Also, how about adding a `text-start' special case which would stand for
(+ (scroll-bar . left) left-fringe left-margin) so that we don't have to
remember all the possible display elements and so that when we decide to
add yet another display element we won't have to update the code.


        Stefan

Re: ruler support in hexl mode

[Kim F. Storm]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

> > You can drop all of that ruler-mode- stuff if you use the advanced
> > pixel-alignment form of :align-to (see xdisp.c around line 17990):
> 
> Hey neat.  When was this added?
> 
> >   (let ((s " 87654321  0011 2233 4455 6677 8899 aabb ccdd eeff  0123456789abcdef")
> >         (pos 0))
> >     ;; 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
> >                                               ,(1- pos)))
> >                          s))
> 
> Note that if there's no margin (i.e. 99% of the time) this will not align
> things properly on a text terminal.  This is the reason why I do
> a `make-string' for the leading space: the size of the string is used
> for alignment in text-terminals while the `display' prop is used otherwise.

Clever!  I didn't consider that.

> 
> Of course, the text-terminal display engine should ideally be improved to
> understand :align-to and such things, but I won't be the one to implement it.

I can give it a try.

> 
> Also, how about adding a `text-start' special case which would stand for
> (+ (scroll-bar . left) left-fringe left-margin) so that we don't have to
> remember all the possible display elements and so that when we decide to
> add yet another display element we won't have to update the code.

That's a good idea.  I'll do that.

-- 
Kim F. Storm <storm@cua.dk> http://www.cua.dk

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 @@
 \f
 ;;; 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))))
 \f
 ;; Blinking cursor

Re: ruler support in hexl mode

[Stefan Monnier]

> 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.

Comments:

> +(defcustom hexl-use-ruler t
> +  "If non-nil then show the ruler for hexl mode."
> +  :type 'boolean
> +  :group 'hexl)

I'd call it hexl-use-header-line, but maybe that's just me.

> +(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)

I'd call it `hexl-ascii-cursor' since the user might not know it's an
overlay (and it could actually be implemented as a text-property tomorrow).
Also I'd stick to just `:inverse-video' as much as possible or more
specifically I'd try to make it look just like the normal cursor (since
there's conceptually no difference between the two).

> +(defcustom hexl-follow-line t
> +  "If non-nil then turn `hl-line-mode' on."
> +  :type 'boolean
> +  :group 'hexl)
[...]
> +    (if hexl-follow-line  (hexl-follow-line 1)))
>    (run-hooks 'hexl-mode-hook))
[...]
> +(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))))

You could define this with `define-minor-mode'.
But I'd recommend to go even further and replace the above with:

(defcustom hexl-mode-hook ()
  "Blabla"
  :type 'hook
  :options '(hexl-follow-line))

(defun hexl-follow-line ()
  (hl-line-mode 1))


-- Stefan

Re: ruler support in hexl mode

[Masatake YAMATO]

> > +(defcustom hexl-use-ruler t
> > +  "If non-nil then show the ruler for hexl mode."
> > +  :type 'boolean
> > +  :group 'hexl)
> 
> I'd call it hexl-use-header-line, but maybe that's just me.

I will use hexl-use-ruler. After thinking I have defined
`ruler-mode-ruler-function' in ruler-mode.el. With the variable, you
can define a mode specific ruler. I have used `ruler-mode-ruler-function'
in hexl-mode.el. As the result I dont have to create a backup of
header format; ruler-mode does it.

> > +(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)
> 
> I'd call it `hexl-ascii-cursor' since the user might not know it's an
> overlay (and it could actually be implemented as a text-property tomorrow).
> Also I'd stick to just `:inverse-video' as much as possible or more
> specifically I'd try to make it look just like the normal cursor (since
> there's conceptually no difference between the two).

You are right. I have changed the code as you wrote.

> You could define this with `define-minor-mode'.
> But I'd recommend to go even further and replace the above with:
> 
> (defcustom hexl-mode-hook ()
>   "Blabla"
>   :type 'hook
>   :options '(hexl-follow-line))
> 
> (defun hexl-follow-line ()
>   (hl-line-mode 1))

Smart. I use this technique both in follow-line and ruler.
I've turned hl-line and ruler on in default.

Summary of changes since last review:
- scroll-bar-columns is moved from frame.el to scroll-bar.el, and
- ruler-mode-current-column-face is used in hexl's ruler, and
- ruler-mode-ruler-function is introduced in ruler-mode.el.

Regards,
Masatake YAMATO

Index: lisp/scroll-bar.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/scroll-bar.el,v
retrieving revision 1.48
diff -u -r1.48 scroll-bar.el
--- lisp/scroll-bar.el	20 Sep 2003 23:33:37 -0000	1.48
+++ lisp/scroll-bar.el	13 Mar 2004 17:58:41 -0000
@@ -54,6 +54,23 @@
   ;; 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))))
+
 \f
 ;;;; Helpful functions for enabling and disabling scroll bars.
 
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	13 Mar 2004 17:58:42 -0000
@@ -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 @@
   "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 @@
   "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
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	13 Mar 2004 17:58:42 -0000
@@ -43,6 +43,11 @@
 ;;; Code:
 
 (require 'eldoc)
+(require 'ruler-mode)
+(require 'frame)
+(require 'fringe)
+(eval-when-compile
+  (require 'hl-line))
 
 ;;
 ;; vars here
@@ -78,6 +83,27 @@
   :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))
+
+(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-cursor
+  '((((class color)) (:foreground "blue" :background "cyan" :underline t))
+    (t (:inverse-video t)))
+  "Face for the cursor in ascii area of hexl mode buffer."
+  :group 'hexl)
+
 (defvar hexl-max-address 0
   "Maximum offset into hexl buffer.")
 
@@ -245,6 +271,10 @@
     (eldoc-remove-command "hexl-save-buffer" 
 			  "hexl-current-address")
 
+    ;; Set a callback function for ruler. 
+    (set (make-local-variable 'ruler-mode-ruler-function) 
+	 'hexl-mode-ruler)
+
     (if hexl-follow-ascii (hexl-follow-ascii 1)))
   (run-hooks 'hexl-mode-hook))
 
@@ -648,6 +678,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))))
 
@@ -865,6 +904,14 @@
 	    (remove-hook 'post-command-hook 'hexl-follow-ascii-find t)
 	    )))))
 
+(defun hexl-activate-ruler ()
+  "Activate `ruler-mode'"
+  (ruler-mode 1))
+
+(defun hexl-follow-line ()
+  "Activate `hl-line-mode'"
+  (hl-line-mode 1))
+
 (defun hexl-follow-ascii-find ()
   "Find and highlight the ASCII element corresponding to current point."
   (let ((pos (+ 51
@@ -872,6 +919,37 @@
 		(mod (hexl-current-address) 16))))
     (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 'ruler-mode-current-column-face s)
+    ;; Highlight the current ascii column
+    (put-text-property (+ 12 39 highlight) (+ 12 40 highlight)
+		       'face 'ruler-mode-current-column-face 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	13 Mar 2004 17:58:42 -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

Re: ruler support in hexl mode

[Richard Stallman]

    Note that if there's no margin (i.e. 99% of the time) this will not align
    things properly on a text terminal.  This is the reason why I do
    a `make-string' for the leading space: the size of the string is used
    for alignment in text-terminals while the `display' prop is used otherwise.

Should this be documented in the Lisp manual along with the :align-to
feature?

    Also, how about adding a `text-start' special case which would stand for
    (+ (scroll-bar . left) left-fringe left-margin) so that we don't have to

Could you be more specific about the change you have in mind?

Re: ruler support in hexl mode

[Masatake YAMATO]

I've installed "ruler support in hexl mode" code.
I've changed a bit from the last posted patch; I'm using hl-line
but the whole line is not highlighted. Only address prefix area
is highlighted. See `hl-line-range-function' in hl-line.el.

Thank the reviewers.
Masatake YAMATO

Re: ruler support in hexl mode

[Kim F. Storm]

Richard Stallman <rms@gnu.org> writes:

>     Note that if there's no margin (i.e. 99% of the time) this will not align
>     things properly on a text terminal.  This is the reason why I do
>     a `make-string' for the leading space: the size of the string is used
>     for alignment in text-terminals while the `display' prop is used otherwise.
> 
> Should this be documented in the Lisp manual along with the :align-to
> feature?

I think it would be better do add :align-to support to the text terminal.
It is on my to-do list to add that.

> 
>     Also, how about adding a `text-start' special case which would stand for
>     (+ (scroll-bar . left) left-fringe left-margin) so that we don't have to
> 
> Could you be more specific about the change you have in mind?
> 
> 

It should be possible to say :align-to 'text-left to have text in the
header line (or mode line) exactly aligned to the left edge of the text
area of the window.  That is possible with the expression given above,
but it is the wrong approach for that purpose.  

I will work on it.

-- 
Kim F. Storm <storm@cua.dk> http://www.cua.dk

Re: ruler support in hexl mode

[Richard Stallman]

    > Should this be documented in the Lisp manual along with the :align-to
    > feature?

    I think it would be better do add :align-to support to the text terminal.
    It is on my to-do list to add that.

That would be a step forward.  However, I don't know how soon
you will have time to work on this.  If it won't be soon, maybe
we should document the current situation in the manual now.

    It should be possible to say :align-to 'text-left to have text in the
    header line (or mode line) exactly aligned to the left edge of the text
    area of the window.

Ok, that feature makes sense.

Re: ruler support in hexl mode

[Kim F. Storm]

Richard Stallman <rms@gnu.org> writes:

>     > Should this be documented in the Lisp manual along with the :align-to
>     > feature?
> 
>     I think it would be better do add :align-to support to the text terminal.
>     It is on my to-do list to add that.
> 
> That would be a step forward.  However, I don't know how soon
> you will have time to work on this.  If it won't be soon, maybe
> we should document the current situation in the manual now.

I can work on it quite soon.

> 
>     It should be possible to say :align-to 'text-left to have text in the
>     header line (or mode line) exactly aligned to the left edge of the text
>     area of the window.


I have been thinking about a different (and IMHO much better) approach
for :align-to on header line and mode line:

Currently, :align-to on normal text lines are relative to the left
text area margin, while for header and mode lines, :align-to is
relative to the left edge of the window (outside fringes, scroll-bar,
and display margin).

My suggestion is that (by default) :align-to in header and mode lines
should also be relative to the left edge of the text area,
e.g. :align-to 0 would align exactly to the first column of the text
area.

The advantage of this approach is that we would then use the same
values for alignment as in the text area, and consequently not require
any special parameters for the "normal" case.

If you want to align header or mode line to a specific "non-text" display
element, use something like
  :align-to 'left-fringe
  :align-to '(+ left-margin 2)
  :align-to 'left-scroll-bar

This seems much more logical than the current approach.

The only real problem with this is that it isn't backwards compatible
with the 21.1 behaviour.  But I suppose there are not that many
packages using :align-to in header line (yet).

WDYT?

-- 
Kim F. Storm <storm@cua.dk> http://www.cua.dk

Re: ruler support in hexl mode

[Stefan Monnier]

> My suggestion is that (by default) :align-to in header and mode lines
> should also be relative to the left edge of the text area,
> e.g. :align-to 0 would align exactly to the first column of the text
> area.

Sounds right to me,


        Stefan

Re: ruler support in hexl mode

[Kim F. Storm]

storm@cua.dk (Kim F. Storm) writes:

> Richard Stallman <rms@gnu.org> writes:
> 
> >     > Should this be documented in the Lisp manual along with the :align-to
> >     > feature?
> > 
> >     I think it would be better do add :align-to support to the text terminal.
> >     It is on my to-do list to add that.
> > 
> > That would be a step forward.  However, I don't know how soon
> > you will have time to work on this.  If it won't be soon, maybe
> > we should document the current situation in the manual now.
> 
> I can work on it quite soon.

I already have something which is working...  Will commit later this week.


-- 
Kim F. Storm <storm@cua.dk> http://www.cua.dk

Re: ruler support in hexl mode

[Miles Bader]

Juanma Barranquero <jmbarranquero@wke.es> writes:
> > Please do not use a `-face' suffix for face names -- it's unnecessary and
> > redundant (faces have their own namespace).  These faces should be called
> > just `hexl-address-area' and `hexl-ascii-area'.
>
> Time for a `make-obsolete-face' function? :)

It'd be nice... [also for modeline vs. mode-line -- both `work', but
not very well, you can end with customizations attached to both, which
can be very confusing!]

-Miles
-- 
Any man who is a triangle, has thee right, when in Cartesian Space, to
have angles, which when summed, come to know more, nor no less, than
nine score degrees, should he so wish.  [TEMPLE OV THEE LEMUR]

Re: ruler support in hexl mode

[Juanma Barranquero]

On 17 Mar 2004 12:59:31 +0900, Miles Bader <miles@lsi.nec.co.jp> wrote:

> Juanma Barranquero <jmbarranquero@wke.es> writes:
> > Time for a `make-obsolete-face' function? :)
> 
> It'd be nice...

Well, if there's really interest, I could commit the following patch:


------ cut here ------ cut here ------ cut here ------ cut here ------
Index: faces.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/faces.el,v
retrieving revision 1.282
diff -u -2 -r1.282 faces.el
--- faces.el	27 Feb 2004 17:30:23 -0000	1.282
+++ faces.el	17 Mar 2004 10:16:35 -0000
@@ -1243,5 +1243,6 @@
 	  (if (not (facep f))
 	      (insert "   undefined face.\n")
-	    (let ((customize-label "customize this face"))
+	    (let ((customize-label "customize this face")
+                  (obsolete (get f 'byte-obsolete-face)))
 	      (princ (concat " (" customize-label ")\n"))
 	      (insert "Documentation: "
@@ -1249,4 +1250,12 @@
 			  "Not documented as a face.")
 		      "\n\n")
+              (when obsolete
+                (princ "This face is obsolete")
+                (if (cdr obsolete) (princ (format " since %s" (cdr obsolete))))
+                (princ ";") (terpri)
+                (princ (if (stringp (car obsolete)) (car obsolete)
+                         (format "use `%s' instead." (car obsolete))))
+                (terpri)
+                (terpri))
 	      (with-current-buffer standard-output
 		(save-excursion
Index: emacs-lisp/byte-run.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/emacs-lisp/byte-run.el,v
retrieving revision 1.3
diff -u -2 -r1.3 byte-run.el
--- emacs-lisp/byte-run.el	18 Mar 2004 00:17:17 -0000	1.3
+++ emacs-lisp/byte-run.el	17 Mar 2004 10:21:16 -0000
@@ -106,4 +106,21 @@
   var)
 
+(defun make-obsolete-face (face new &optional when)
+  "Make the byte-compiler warn that FACE is obsolete.
+The warning will say that NEW should be used instead.
+If NEW is a string, that is the `use instead' message.
+If provided, WHEN should be a string indicating when the face
+was first made obsolete, for example a date or a release number."
+  (interactive
+   (list
+    (let ((old (read-face-name "Make face obsolete")))
+      (if (equal old nil) (error ""))
+      old)
+    (let ((new (read-face-name "Obsoletion replacement")))
+      (if (equal new nil) (error "No replacement face"))
+      new)))
+  (put face 'byte-obsolete-face (cons new when))
+  face)
+
 (put 'dont-compile 'lisp-indent-hook 0)
 (defmacro dont-compile (&rest body)
------ cut here ------ cut here ------ cut here ------ cut here ------


but the problem is, how to make the byte-compiler warn when using an
obsolete face? AFAICS, face names are just symbols, so other uses of the
symbol would trigger the warning too. For example, with this patch (just
a proof of concept, I know almost nothing about bytecomp.el):


------ cut here ------ cut here ------ cut here ------ cut here ------
Index: bytecomp.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/emacs-lisp/bytecomp.el,v
retrieving revision 2.143
diff -u -2 -r2.143 bytecomp.el
--- bytecomp.el	12 Mar 2004 10:09:59 -0000	2.143
+++ bytecomp.el	18 Mar 2004 00:47:31 -0000
@@ -2788,5 +2788,14 @@
       (setq for-effect nil)
     (when (symbolp const)
-      (byte-compile-set-symbol-position const))
+      (byte-compile-set-symbol-position const)
+      (if (and (get const 'byte-obsolete-face)
+               (memq 'obsolete byte-compiler-warnings))
+          (let* ((ob (get const 'byte-obsolete-face))
+                 (when (cdr ob)))
+            (byte-compile-warn "%s is an obsolete face%s; %s" const
+                               (if when (concat " since " when) "")
+                               (if (stringp (car ob))
+                                   (car ob)
+                                 (format "use %s instead." (car ob)))))))
     (byte-compile-out 'byte-constant (byte-compile-get-constant const)))) 

------ cut here ------ cut here ------ cut here ------ cut here ------


you can certainly do (make-obsolete-face 'modeline 'mode-line "21.5")
and get a warning in compilation, but then so does every other use of
'modeline, even if it's not used as a a face. Any easy way to solve this
or do it right?

                                                           /L/e/k/t/u

Re: ruler support in hexl mode

[Richard Stallman]

    My suggestion is that (by default) :align-to in header and mode lines
    should also be relative to the left edge of the text area,
    e.g. :align-to 0 would align exactly to the first column of the text
    area.

certainly simpler.  you cd use negative number if youreally want
a pos before the text area. so no loss of function. sounds good.

    The only real problem with this is that it isn't backwards compatible
    with the 21.1 behaviour.  But I suppose there are not that many
    packages using :align-to in header line (yet).

exactly.  please do it.

Re: ruler support in hexl mode

[Kim F. Storm]

Richard Stallman <rms@gnu.org> writes:

>     My suggestion is that (by default) :align-to in header and mode lines
>     should also be relative to the left edge of the text area,
>     e.g. :align-to 0 would align exactly to the first column of the text
>     area.
> 
> certainly simpler.  you cd use negative number if youreally want
> a pos before the text area. so no loss of function. sounds good.

> please do it.

Done.

To clarify:

With my fixes, the default position for header and mode lines (if no
:align-to is used) is still the left edge of the window (mode lines
certainly expect that).

With :align-to N (N is a number, also negative) you offset from the
left edge of the text area.

With :align-to (+ left-margin N) you offset from the left edge of
the left margin.

This also works in normal text rows, so you can align normal text
relative to the various window "decorations" (I'm not sure when that
would be useful, but it works nevertheless).

To center something above the left-margin, you can use

        :align-to (+ left-margin (0.5 . left-margin))

You can also align relative to the right edge of the text area, e.g.
10 character positions from the right margin is specified with:
        
        :align-to (- right 10)

And it works on text terminals as well!


I still need to write the necessary info in NEWS and display.texi.
Will do so asap.

-- 
Kim F. Storm <storm@cua.dk> http://www.cua.dk

Re: ruler support in hexl mode

[Kim F. Storm]

FYI, I have adapted hexl-mode-ruler to the new :align-to semantics.

-- 
Kim F. Storm <storm@cua.dk> http://www.cua.dk

Re: ruler support in hexl mode

[Richard Stallman]

    but the problem is, how to make the byte-compiler warn when using an
    obsolete face? AFAICS, face names are just symbols, so other uses of the
    symbol would trigger the warning too.

That is indeed the hard part.  Perhaps one could make a list of
functions that faces are commonly specified to, and check for use
of an obsolete face name quoted as an argument.
For instance, (overlay-put ... 'face 'OBSOLETE-FACE-NAME)
would trigger the warning.

Re: ruler support in hexl mode

[Juanma Barranquero]

On Fri, 19 Mar 2004 23:48:23 -0500
Richard Stallman <rms@gnu.org> wrote:

> Perhaps one could make a list of
> functions that faces are commonly specified to, and check for use
> of an obsolete face name quoted as an argument.

I had thought of adding a property to face-using functions, which would
say what arguments can be faces, i.e.:

(put 'copy-face 'byte-compile-uses-faces '(1 2))

and then checking when compiling. There should be also a way to mark
functions that can receive faces in generic arguments, like `overlay-put'.
I favor this kind of answer because assigning the property would be
close to the function declaration, so harder to forget than going to
emacs-lisp/bytecomp.el to update a list. But perhaps what you propose is
better/easier, don't know.

In any case, I'm no expert in emacs-lisp/byte*.el, so any pointer about
when/how to check the arguments would be welcome.

                                                                Juanma