Sync to HEAD
[bpt/emacs.git] / lisp / hexl.el
index ca08405..cc36c37 100644 (file)
@@ -1,6 +1,6 @@
 ;;; hexl.el --- edit a file in a hex dump format using the hexl filter
 
-;; Copyright (C) 1989, 1994, 1998, 2001 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
 ;; a program called hexl, supplied with the GNU Emacs distribution, that
 ;; can filter a binary into an editable format or from the format back into
 ;; binary.  For full instructions, invoke `hexl-mode' on an empty buffer and
-;; do `M-x describe-mode'.
+;; do M-x `describe-mode'.
 ;;
-;; This may be useful in your .emacs:
-;;
-;;     (autoload 'hexl-find-file "hexl"
-;;       "Edit file FILENAME in hexl-mode." t)
-;;     
-;;     (define-key global-map "\C-c\C-h" 'hexl-find-file)
-;;
-;; NOTE: Remember to change HEXL-PROGRAM or HEXL-OPTIONS if needed.
+;; NOTE: Remember to change `hexl-program' or `hexl-options' if needed.
 ;;
 ;; Currently hexl only supports big endian hex output with 16 bit
 ;; grouping.
@@ -49,6 +42,8 @@
 
 ;;; Code:
 
+(require 'eldoc)
+
 ;;
 ;; vars here
 ;;
@@ -72,25 +67,8 @@ and \"-de\" when dehexlifying a buffer."
   :group 'hexl)
 
 (defcustom hexl-options (format "-hex %s" hexl-iso)
-  "Options to hexl-program that suit your needs."
-  :type 'string
-  :group 'hexl)
-
-(defcustom hexlify-command
-  (format "%s %s"
-         (shell-quote-argument
-          (expand-file-name hexl-program exec-directory))
-         hexl-options)
-  "The command to use to hexlify a buffer."
-  :type 'string
-  :group 'hexl)
-
-(defcustom dehexlify-command
-  (format "%s -de %s"
-         (shell-quote-argument
-          (expand-file-name hexl-program exec-directory))
-         hexl-options)
-  "The command to use to unhexlify a buffer."
+  "Space separated options to `hexl-program' that suit your needs.
+Quoting cannot be used, so the arguments cannot themselves contain spaces."
   :type 'string
   :group 'hexl)
 
@@ -100,6 +78,22 @@ and \"-de\" when dehexlifying a buffer."
   :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.")
 
@@ -108,7 +102,7 @@ and \"-de\" when dehexlifying a buffer."
 (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)
 
@@ -124,7 +118,7 @@ and \"-de\" when dehexlifying a buffer."
 (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
@@ -154,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
@@ -198,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)))
@@ -235,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)
@@ -243,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)
@@ -254,15 +250,33 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode.
     (setq require-final-newline nil)
 
     ;; Add hooks to rehexlify or dehexlify on various events.
-    (make-local-hook 'after-revert-hook)
     (add-hook 'after-revert-hook 'hexl-after-revert-hook nil t)
 
-    (make-local-hook 'change-major-mode-hook)
     (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)
@@ -303,8 +317,13 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode.
 (defun hexl-find-file (filename)
   "Edit file FILENAME in hexl-mode.
 Switch to a buffer visiting file FILENAME, creating one in none exists."
-  (interactive "fFilename: ")
-  (find-file-literally filename)
+  (interactive
+   (list
+    (let ((completion-ignored-extensions nil))
+      (read-file-name "Filename: " nil nil 'ret-must-match))))
+  ;; 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)))
 
@@ -317,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.
@@ -332,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)
@@ -348,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.
@@ -636,7 +661,18 @@ This discards the buffer's undo information."
   (let ((coding-system-for-read 'raw-text)
        (coding-system-for-write buffer-file-coding-system)
        (buffer-undo-list t))
-    (shell-command-on-region (point-min) (point-max) hexlify-command t)
+    (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))))
 
@@ -651,7 +687,9 @@ This discards the buffer's undo information."
   (let ((coding-system-for-write 'raw-text)
        (coding-system-for-read buffer-file-coding-system)
        (buffer-undo-list t))
-    (shell-command-on-region (point-min) (point-max) dehexlify-command t)))
+    (apply 'call-process-region (point-min) (point-max)
+          (expand-file-name hexl-program exec-directory)
+          t t nil "-de" (split-string hexl-options))))
 
 (defun hexl-char-after-point ()
   "Return char for ASCII hex digits at point."
@@ -703,7 +741,7 @@ and their encoded form is inserted byte by byte."
           (hexl-insert-char ch num))
          ((eq charset 'unknown)
           (error
-           "0x%x -- invalid character code; use \\[hexl-insert-hex-string]."
+           "0x%x -- invalid character code; use \\[hexl-insert-hex-string]"
            ch))
          (t
           (let ((encoded (encode-coding-char ch coding))
@@ -723,7 +761,7 @@ and their encoded form is inserted byte by byte."
                     ch internal-hex))
                   (setq encoded internal)
                 (error
-                 "Can't encode `0x%x' with this buffer's coding system; try \\[hexl-insert-hex-string]."
+                 "Can't encode `0x%x' with this buffer's coding system; try \\[hexl-insert-hex-string]"
                  ch)))
             (while (> num 0)
               (mapc
@@ -744,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))
@@ -831,12 +869,10 @@ 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))))
 
-    (make-local-hook 'post-command-hook)
-                   
     (if on-p
       ;; turn it on
       (if (not hexl-ascii-overlay)
@@ -854,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
@@ -862,17 +923,40 @@ 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
     nil
-  (setq hexl-mode-map (copy-keymap (current-global-map)))
+  (setq hexl-mode-map (make-keymap))
   ;; 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)
+  (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)
@@ -957,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