unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* ruler support in hexl mode
@ 2004-03-05  5:29 Masatake YAMATO
  2004-03-08 20:05 ` Stefan Monnier
  2004-03-08 21:00 ` Miles Bader
  0 siblings, 2 replies; 26+ messages in thread
From: Masatake YAMATO @ 2004-03-05  5:29 UTC (permalink / raw)


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.

^ permalink raw reply	[flat|nested] 26+ messages in thread

end of thread, other threads:[~2004-03-22 11:52 UTC | newest]

Thread overview: 26+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2004-03-05  5:29 ruler support in hexl mode Masatake YAMATO
2004-03-08 20:05 ` Stefan Monnier
2004-03-09 12:11   ` Masatake YAMATO
2004-03-11  6:59   ` Masatake YAMATO
2004-03-11 16:27   ` Kim F. Storm
2004-03-11 17:43     ` Stefan Monnier
2004-03-11 23:56       ` Kim F. Storm
2004-03-12  6:05         ` Masatake YAMATO
2004-03-12 21:24           ` Stefan Monnier
2004-03-13 18:13             ` Masatake YAMATO
2004-03-15  7:37               ` Masatake YAMATO
2004-03-15  4:55       ` Richard Stallman
2004-03-15 11:00         ` Kim F. Storm
2004-03-16 19:02           ` Richard Stallman
2004-03-17  0:08             ` Kim F. Storm
2004-03-17  0:42               ` Stefan Monnier
2004-03-17  2:23               ` Kim F. Storm
2004-03-19  5:01               ` Richard Stallman
2004-03-19 10:06                 ` Kim F. Storm
2004-03-19 13:33                   ` Kim F. Storm
2004-03-08 21:00 ` Miles Bader
2004-03-11 14:41   ` Juanma Barranquero
2004-03-17  3:59     ` Miles Bader
2004-03-18  0:53       ` Juanma Barranquero
2004-03-20  4:48         ` Richard Stallman
2004-03-22 11:52           ` Juanma Barranquero

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).