X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e49a45ad850878d603332b3dc3c26c125fd0a61c..9edfb3d2a1d7480ed6566c5e7b25036d9c47eb19:/lisp/hexl.el

diff --git a/lisp/hexl.el b/lisp/hexl.el
index 7c4a1610b9..cc36c37602 100644
--- a/lisp/hexl.el
+++ b/lisp/hexl.el
@@ -1,6 +1,6 @@
 ;;; hexl.el --- edit a file in a hex dump format using the hexl filter
 
-;; Copyright (C) 1989, 1994, 1998, 2001, 2002 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 1994, 1998, 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
 
 ;; Author: Keith Gabryelski <ag@wheaties.ai.mit.edu>
 ;; Maintainer: FSF
@@ -42,6 +42,8 @@
 
 ;;; Code:
 
+(require 'eldoc)
+
 ;;
 ;; vars here
 ;;
@@ -76,6 +78,22 @@ Quoting cannot be used, so the arguments cannot themselves contain spaces."
   :group 'hexl
   :version "20.3")
 
+(defcustom hexl-mode-hook '(hexl-follow-line hexl-activate-ruler)
+  "Normal hook run when entering Hexl mode."
+  :type 'hook
+  :options '(hexl-follow-line hexl-activate-ruler turn-on-eldoc-mode)
+  :group 'hexl)
+
+(defface hexl-address-area
+  '((t (:inherit header-line)))
+  "Face used in address are of hexl-mode buffer."
+  :group 'hexl)
+
+(defface hexl-ascii-area
+  '((t (:inherit header-line)))
+  "Face used in ascii are of hexl-mode buffer."
+  :group 'hexl)
+
 (defvar hexl-max-address 0
   "Maximum offset into hexl buffer.")
 
@@ -84,7 +102,7 @@ Quoting cannot be used, so the arguments cannot themselves contain spaces."
 (defvar hexl-mode-old-local-map)
 (defvar hexl-mode-old-mode-name)
 (defvar hexl-mode-old-major-mode)
-(defvar hexl-mode-old-write-contents-hooks)
+(defvar hexl-mode-old-isearch-search-fun-function)
 (defvar hexl-mode-old-require-final-newline)
 (defvar hexl-mode-old-syntax-table)
 
@@ -100,7 +118,7 @@ Quoting cannot be used, so the arguments cannot themselves contain spaces."
 (defun hexl-mode (&optional arg)
   "\\<hexl-mode-map>A mode for editing binary files in hex dump format.
 This is not an ordinary major mode; it alters some aspects
-if the current mode's behavior, but not all; also, you can exit
+of the current mode's behavior, but not all; also, you can exit
 Hexl mode and return to the previous mode using `hexl-mode-exit'.
 
 This function automatically converts a buffer into the hexl format
@@ -130,10 +148,10 @@ A sample format:
   00000050: 6162 6c65 2041 5343 4949 2063 6861 7261  able ASCII chara
   00000060: 6374 6572 732e 2020 416e 7920 636f 6e74  cters.  Any cont
   00000070: 726f 6c20 6f72 206e 6f6e 2d41 5343 4949  rol or non-ASCII
-  00000080: 2063 6861 7261 6374 6572 730a 6172 6520   characters.are 
+  00000080: 2063 6861 7261 6374 6572 730a 6172 6520   characters.are
   00000090: 6469 7370 6c61 7965 6420 6173 2070 6572  displayed as per
   000000a0: 696f 6473 2069 6e20 7468 6520 7072 696e  iods in the prin
-  000000b0: 7461 626c 6520 6368 6172 6163 7465 7220  table character 
+  000000b0: 7461 626c 6520 6368 6172 6163 7465 7220  table character
   000000c0: 7265 6769 6f6e 2e0a                      region..
 
 Movement is as simple as movement in a normal emacs text buffer.  Most
@@ -174,7 +192,7 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode.
   (unless (eq major-mode 'hexl-mode)
     (let ((modified (buffer-modified-p))
 	  (inhibit-read-only t)
-	  (original-point (1- (point)))
+	  (original-point (- (point) (point-min)))
 	  max-address)
       (and (eobp) (not (bobp))
 	   (setq original-point (1- original-point)))
@@ -211,6 +229,11 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode.
     (setq hexl-mode-old-mode-name mode-name)
     (setq mode-name "Hexl")
 
+    (set (make-local-variable 'hexl-mode-old-isearch-search-fun-function)
+	 isearch-search-fun-function)
+    (set (make-local-variable 'isearch-search-fun-function)
+	 'hexl-isearch-search-function)
+
     (make-local-variable 'hexl-mode-old-major-mode)
     (setq hexl-mode-old-major-mode major-mode)
     (setq major-mode 'hexl-mode)
@@ -219,10 +242,7 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode.
     (setq hexl-mode-old-syntax-table (syntax-table))
     (set-syntax-table (standard-syntax-table))
 
-    (make-local-variable 'hexl-mode-old-write-contents-hooks)
-    (setq hexl-mode-old-write-contents-hooks write-contents-hooks)
-    (make-local-variable 'write-contents-hooks)
-    (add-hook 'write-contents-hooks 'hexl-save-buffer)
+    (add-hook 'write-contents-functions 'hexl-save-buffer nil t)
 
     (make-local-variable 'hexl-mode-old-require-final-newline)
     (setq hexl-mode-old-require-final-newline require-final-newline)
@@ -234,9 +254,29 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode.
 
     (add-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer nil t)
 
+    ;; Set a callback function for eldoc.
+    (set (make-local-variable 'eldoc-print-current-symbol-info-function)
+	 'hexl-print-current-point-info)
+    (eldoc-add-command-completions "hexl-")
+    (eldoc-remove-command "hexl-save-buffer" 
+			  "hexl-current-address")
+
     (if hexl-follow-ascii (hexl-follow-ascii 1)))
   (run-hooks 'hexl-mode-hook))
 
+
+(defun hexl-isearch-search-function ()
+  (if (and (not isearch-regexp) (not isearch-word))
+      (lambda (string &optional bound noerror count)
+	(funcall
+	 (if isearch-forward 're-search-forward 're-search-backward)
+	 (if (> (length string) 80)
+	     (regexp-quote string)
+	   (mapconcat 'string string "\\(?:\n\\(?:[:a-f0-9]+ \\)+ \\)?"))
+	 bound noerror count))
+    (let ((isearch-search-fun-function nil))
+      (isearch-search-fun))))
+
 (defun hexl-after-revert-hook ()
   (setq hexl-max-address (1- (buffer-size)))
   (hexlify-buffer)
@@ -281,7 +321,9 @@ Switch to a buffer visiting file FILENAME, creating one in none exists."
    (list
     (let ((completion-ignored-extensions nil))
       (read-file-name "Filename: " nil nil 'ret-must-match))))
-  (find-file-literally filename)
+  ;; Ignore the user's setting of default-major-mode.
+  (let ((default-major-mode 'fundamental-mode))
+    (find-file-literally filename))
   (if (not (eq major-mode 'hexl-mode))
       (hexl-mode)))
 
@@ -294,7 +336,7 @@ With arg, don't unhexlify buffer."
 	    (inhibit-read-only t)
 	    (original-point (1+ (hexl-current-address))))
 	(dehexlify-buffer)
-	(remove-hook 'write-contents-hooks 'hexl-save-buffer)
+	(remove-hook 'write-contents-functions 'hexl-save-buffer t)
 	(set-buffer-modified-p modified)
 	(goto-char original-point)
 	;; Maybe adjust point for the removed CR characters.
@@ -309,9 +351,9 @@ With arg, don't unhexlify buffer."
   (remove-hook 'post-command-hook 'hexl-follow-ascii-find t)
   (setq hexl-ascii-overlay nil)
 
-  (setq write-contents-hooks hexl-mode-old-write-contents-hooks)
   (setq require-final-newline hexl-mode-old-require-final-newline)
   (setq mode-name hexl-mode-old-mode-name)
+  (setq isearch-search-fun-function hexl-mode-old-isearch-search-fun-function)
   (use-local-map hexl-mode-old-local-map)
   (set-syntax-table hexl-mode-old-syntax-table)
   (setq major-mode hexl-mode-old-major-mode)
@@ -325,32 +367,38 @@ Ask the user for confirmation."
 	    (inhibit-read-only t)
 	    (original-point (1+ (hexl-current-address))))
 	(dehexlify-buffer)
-	(remove-hook 'write-contents-hooks 'hexl-save-buffer)
+	(remove-hook 'write-contents-functions 'hexl-save-buffer t)
 	(set-buffer-modified-p modified)
 	(goto-char original-point))))
 
 (defun hexl-current-address (&optional validate)
   "Return current hexl-address."
   (interactive)
-  (let ((current-column (- (% (point) 68) 11))
+  (let ((current-column (- (% (- (point) (point-min) -1) 68) 11))
 	(hexl-address 0))
     (if (< current-column 0)
 	(if validate
 	    (error "Point is not on a character in the file")
 	  (setq current-column 0)))
     (setq hexl-address
-	  (+ (* (/ (point) 68) 16)
+	  (+ (* (/ (- (point) (point-min) -1) 68) 16)
 	     (if (>= current-column 41)
 		 (- current-column 41)
 	       (/ (- current-column  (/ current-column 5)) 2))))
     (when (interactive-p)
-      (message "Current address is %d" hexl-address))
+      (message "Current address is %d/0x%08x" hexl-address hexl-address))
     hexl-address))
 
+(defun hexl-print-current-point-info ()
+  "Return current hexl-address in string.
+This function is indented to be used as eldoc callback."
+  (let ((addr (hexl-current-address)))
+    (format "Current address is %d/0x%08x" addr addr)))
+
 (defun hexl-address-to-marker (address)
   "Return buffer position for ADDRESS."
   (interactive "nAddress: ")
-  (+ (* (/ address 16) 68) 11 (/ (* (% address 16) 5) 2)))
+  (+ (* (/ address 16) 68) 10 (point-min) (/ (* (% address 16) 5) 2)))
 
 (defun hexl-goto-address (address)
   "Goto hexl-mode (decimal) address ADDRESS.
@@ -616,6 +664,15 @@ This discards the buffer's undo information."
     (apply 'call-process-region (point-min) (point-max)
 	   (expand-file-name hexl-program exec-directory)
 	   t t nil (split-string hexl-options))
+    (save-excursion
+      (goto-char (point-min))
+      (while (re-search-forward "^[0-9a-f]+:" nil t)
+	(put-text-property (match-beginning 0) (match-end 0)
+			   'font-lock-face 'hexl-address-area))
+      (goto-char (point-min))
+      (while (re-search-forward "  \\(.+$\\)" nil t)
+	(put-text-property (match-beginning 1) (match-end 1) 
+			   'font-lock-face 'hexl-ascii-area)))
     (if (> (point) (hexl-address-to-marker hexl-max-address))
 	(hexl-goto-address hexl-max-address))))
 
@@ -725,16 +782,16 @@ and their encoded form is inserted byte by byte."
 
 CH must be a unibyte character whose value is between 0 and 255."
   (if (or (< ch 0) (> ch 255))
-      (error "Invalid character 0x%x -- must be in the range [0..255]"))
+      (error "Invalid character 0x%x -- must be in the range [0..255]" ch))
   (let ((address (hexl-current-address t)))
     (while (> num 0)
       (let ((hex-position
 	     (+ (* (/ address 16) 68)
-		11
+		10 (point-min)
 		(* 2 (% address 16))
 		(/ (% address 16) 2)))
 	    (ascii-position
-	     (+ (* (/ address 16) 68) 52 (% address 16)))
+	     (+ (* (/ address 16) 68) 51 (point-min) (% address 16)))
 	    at-ascii-position)
 	(if (= (point) ascii-position)
 	    (setq at-ascii-position t))
@@ -812,7 +869,7 @@ When following is enabled, the ASCII character corresponding to the
 element under the point is highlighted.
 Customize the variable `hexl-follow-ascii' to disable this feature."
   (interactive "P")
-  (let ((on-p (if arg 
+  (let ((on-p (if arg
 		  (> (prefix-numeric-value arg) 0)
 	       (not hexl-ascii-overlay))))
 
@@ -833,6 +890,31 @@ Customize the variable `hexl-follow-ascii' to disable this feature."
 	    (remove-hook 'post-command-hook 'hexl-follow-ascii-find t)
 	    )))))
 
+(defun hexl-activate-ruler ()
+  "Activate `ruler-mode'"
+  (require 'ruler-mode)
+  (set (make-local-variable 'ruler-mode-ruler-function) 
+       'hexl-mode-ruler)
+  (ruler-mode 1))
+
+(defun hexl-follow-line ()
+  "Activate `hl-line-mode'"
+  (require 'frame)
+  (require 'hl-line)
+  (set (make-local-variable 'hl-line-range-function)
+       'hexl-highlight-line-range)
+  (set (make-local-variable 'hl-line-face) 
+       'highlight)
+  (hl-line-mode 1))
+
+(defun hexl-highlight-line-range ()
+  "Return the range of address area for the point.
+This function is assumed to be used as call back function for `hl-line-mode'."
+  (cons
+   (line-beginning-position)
+   ;; 9 stands for (length "87654321:")
+   (+ (line-beginning-position) 9)))
+
 (defun hexl-follow-ascii-find ()
   "Find and highlight the ASCII element corresponding to current point."
   (let ((pos (+ 51
@@ -841,6 +923,29 @@ Customize the variable `hexl-follow-ascii' to disable this feature."
     (move-overlay hexl-ascii-overlay pos (1+ pos))
     ))
 
+(defun hexl-mode-ruler ()
+  "Return a string ruler for hexl mode."
+  (let* ((highlight (mod (hexl-current-address) 16))
+	 (s " 87654321  0011 2233 4455 6677 8899 aabb ccdd eeff  0123456789abcdef")
+	 (pos 0))
+    (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 ,(1- pos))
+			 s))
+    ;; Highlight the current column.
+    (put-text-property (+ 11 (/ (* 5 highlight) 2))
+		       (+ 13 (/ (* 5 highlight) 2))
+		       'face 'highlight s)
+    ;; Highlight the current ascii column
+    (put-text-property (+ 13 39 highlight) (+ 13 40 highlight)
+		       'face 'highlight s)
+    s))
+
 ;; startup stuff.
 
 (if hexl-mode-map
@@ -849,9 +954,9 @@ Customize the variable `hexl-follow-ascii' to disable this feature."
   ;; Make all self-inserting keys go through hexl-self-insert-command,
   ;; because we need to convert them to unibyte characters before
   ;; inserting them into the buffer.
-  (substitute-key-definition 'self-insert-command 'hexl-self-insert-command
-			     hexl-mode-map (current-global-map))
+  (define-key hexl-mode-map [remap self-insert-command] 'hexl-self-insert-command)
 
+  (define-key hexl-mode-map "\C-m" 'hexl-self-insert-command)
   (define-key hexl-mode-map [left] 'hexl-backward-char)
   (define-key hexl-mode-map [right] 'hexl-forward-char)
   (define-key hexl-mode-map [up] 'hexl-previous-line)
@@ -936,4 +1041,5 @@ Customize the variable `hexl-follow-ascii' to disable this feature."
 
 (provide 'hexl)
 
+;;; arch-tag: d5a7aa8a-9bce-480b-bcff-6c4c7ca5ea4a
 ;;; hexl.el ends here