*** empty log message ***
[bpt/emacs.git] / lisp / hexl.el
index e24f6b7..88c6ca0 100644 (file)
@@ -1,6 +1,7 @@
 ;;; hexl.el --- edit a file in a hex dump format using the hexl filter
 
-;; Copyright (C) 1989, 1994, 1998, 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 1994, 1998, 2001, 2002, 2003, 2004,
+;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 ;; Author: Keith Gabryelski <ag@wheaties.ai.mit.edu>
 ;; Maintainer: FSF
@@ -8,10 +9,10 @@
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -19,9 +20,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -37,7 +36,7 @@
 ;; grouping.
 ;;
 ;; -iso in `hexl-options' will allow iso characters to display in the
-;; ASCII region of the screen (if your emacs supports this) instead of
+;; ASCII region of the screen (if your Emacs supports this) instead of
 ;; changing them to dots.
 
 ;;; Code:
@@ -61,7 +60,7 @@ and \"-de\" when dehexlifying a buffer."
   :group 'hexl)
 
 (defcustom hexl-iso ""
-  "If your emacs can handle ISO characters, this should be set to
+  "If your Emacs can handle ISO characters, this should be set to
 \"-iso\" otherwise it should be \"\"."
   :type 'string
   :group 'hexl)
@@ -84,14 +83,14 @@ Quoting cannot be used, so the arguments cannot themselves contain spaces."
   :options '(hexl-follow-line hexl-activate-ruler turn-on-eldoc-mode)
   :group 'hexl)
 
-(defface hexl-address-area
+(defface hexl-address-region
   '((t (:inherit header-line)))
-  "Face used in address are of hexl-mode buffer."
+  "Face used in address area of hexl-mode buffer."
   :group 'hexl)
 
-(defface hexl-ascii-area
+(defface hexl-ascii-region
   '((t (:inherit header-line)))
-  "Face used in ascii are of hexl-mode buffer."
+  "Face used in ascii area of hexl-mode buffer."
   :group 'hexl)
 
 (defvar hexl-max-address 0
@@ -99,19 +98,27 @@ Quoting cannot be used, so the arguments cannot themselves contain spaces."
 
 (defvar hexl-mode-map nil)
 
+;; Variable declarations for suppressing warnings from the byte-compiler.
 (defvar ruler-mode)
 (defvar ruler-mode-ruler-function)
 (defvar hl-line-mode)
+(defvar hl-line-range-function)
+(defvar hl-line-face)
 
+;; Variables where the original values are stored to.
 (defvar hexl-mode-old-hl-line-mode)
+(defvar hexl-mode-old-hl-line-range-function)
+(defvar hexl-mode-old-hl-line-face)
 (defvar hexl-mode-old-local-map)
 (defvar hexl-mode-old-mode-name)
 (defvar hexl-mode-old-major-mode)
 (defvar hexl-mode-old-ruler-mode)
+(defvar hexl-mode-old-ruler-function)
 (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-font-lock-keywords)
+(defvar hexl-mode-old-eldoc-documentation-function)
 
 (defvar hexl-ascii-overlay nil
   "Overlay used to highlight ASCII element corresponding to current point.")
@@ -120,8 +127,8 @@ Quoting cannot be used, so the arguments cannot themselves contain spaces."
 (defvar hexl-font-lock-keywords
   '(("^\\([0-9a-f]+:\\).\\{40\\}  \\(.+$\\)"
      ;; "^\\([0-9a-f]+:\\).+  \\(.+$\\)"
-     (1 'hexl-address-area t t)
-     (2 'hexl-ascii-area t t)))
+     (1 'hexl-address-region t t)
+     (2 'hexl-ascii-region t t)))
   "Font lock keywords used in `hexl-mode'.")
 
 ;; routines
@@ -168,7 +175,7 @@ A sample format:
   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
+Movement is as simple as movement in a normal Emacs text buffer.  Most
 cursor movement bindings are the same (ie. Use \\[hexl-backward-char], \\[hexl-forward-char], \\[hexl-next-line], and \\[hexl-previous-line]
 to move the cursor left, right, down, and up).
 
@@ -206,31 +213,27 @@ 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 (- (point) (point-min)))
-         max-address)
+         (original-point (- (point) (point-min))))
       (and (eobp) (not (bobp))
           (setq original-point (1- original-point)))
-      (if (not (or (eq arg 1) (not arg)))
-         ;; if no argument then we guess at hexl-max-address
-          (setq max-address (+ (* (/ (1- (buffer-size)) 68) 16) 15))
-        (setq max-address (1- (buffer-size)))
+      ;; If `hexl-mode' is invoked with an argument the buffer is assumed to
+      ;; be in hexl format.
+      (when (memq arg '(1 nil))
        ;; If the buffer's EOL type is -dos, we need to account for
        ;; extra CR characters added when hexlify-buffer writes the
        ;; buffer to a file.
+        ;; FIXME: This doesn't take into account multibyte coding systems.
        (when (eq (coding-system-eol-type buffer-file-coding-system) 1)
-         (setq max-address (+ (count-lines (point-min) (point-max))
-                              max-address))
-         ;; But if there's no newline at the last line, we are off by
-         ;; one; adjust.
-         (or (eq (char-before (point-max)) ?\n)
-             (setq max-address (1- max-address)))
-         (setq original-point (+ (count-lines (point-min) (point))
+          (setq original-point (+ (count-lines (point-min) (point))
                                  original-point))
          (or (bolp) (setq original-point (1- original-point))))
         (hexlify-buffer)
-        (set-buffer-modified-p modified))
-      (make-local-variable 'hexl-max-address)
-      (setq hexl-max-address max-address)
+        (restore-buffer-modified-p modified))
+      (set (make-local-variable 'hexl-max-address)
+           (let* ((full-lines (/ (buffer-size) 68))
+                  (last-line (% (buffer-size) 68))
+                  (last-line-bytes (% last-line 52)))
+             (+ last-line-bytes (* full-lines 16) -1)))
       (condition-case nil
          (hexl-goto-address original-point)
        (error nil)))
@@ -275,19 +278,23 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode.
 
     (make-local-variable 'hexl-mode-old-font-lock-keywords)
     (setq hexl-mode-old-font-lock-keywords font-lock-defaults)
-    (make-local-variable 'font-lock-defaults)
     (setq font-lock-defaults '(hexl-font-lock-keywords t))
 
     ;; Add hooks to rehexlify or dehexlify on various events.
+    (add-hook 'before-revert-hook 'hexl-before-revert-hook nil t)
     (add-hook 'after-revert-hook 'hexl-after-revert-hook nil t)
 
     (add-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer nil t)
 
     ;; Set a callback function for eldoc.
+    (make-local-variable 'hexl-mode-old-eldoc-documentation-function)
+    (setq hexl-mode-old-eldoc-documentation-function
+         (bound-and-true-p eldoc-documentation-function))
+
     (set (make-local-variable 'eldoc-documentation-function)
         'hexl-print-current-point-info)
     (eldoc-add-command-completions "hexl-")
-    (eldoc-remove-command "hexl-save-buffer" 
+    (eldoc-remove-command "hexl-save-buffer"
                          "hexl-current-address")
 
     (if hexl-follow-ascii (hexl-follow-ascii 1)))
@@ -299,17 +306,25 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode.
       (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]+ \\)+ \\)?"))
+         (let ((textre
+                (if (> (length string) 80)
+                    (regexp-quote string)
+                  (mapconcat (lambda (c) (regexp-quote (string c))) string
+                             "\\(?:\n\\(?:[:a-f0-9]+ \\)+ \\)?"))))
+           (if (string-match "\\` ?\\([a-f0-9]+ \\)*[a-f0-9]+ ?\\'" string)
+               (concat textre "\\|"
+                       (mapconcat 'regexp-quote (split-string string " ")
+                                  " \\(?: .+\n[a-f0-9]+: \\)?"))
+             textre))
         bound noerror count))
     (let ((isearch-search-fun-function nil))
       (isearch-search-fun))))
 
+(defun hexl-before-revert-hook ()
+  (remove-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer t))
+
 (defun hexl-after-revert-hook ()
-  (setq hexl-max-address (1- (buffer-size)))
-  (hexlify-buffer)
-  (set-buffer-modified-p nil))
+  (hexl-mode))
 
 (defvar hexl-in-save-buffer nil)
 
@@ -317,35 +332,35 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode.
   "Save a hexl format buffer as binary in visited file if modified."
   (interactive)
   (if hexl-in-save-buffer nil
-    (set-buffer-modified-p (if (buffer-modified-p)
-                              (save-excursion
-                                (let ((buf (generate-new-buffer " hexl"))
-                                      (name (buffer-name))
-                                      (file-name (buffer-file-name))
-                                      (start (point-min))
-                                      (end (point-max))
-                                      modified)
-                                  (set-buffer buf)
-                                  (insert-buffer-substring name start end)
-                                  (set-buffer name)
-                                  (dehexlify-buffer)
-                                  ;; Prevent infinite recursion.
-                                  (let ((hexl-in-save-buffer t))
-                                    (save-buffer))
-                                  (setq modified (buffer-modified-p))
-                                  (delete-region (point-min) (point-max))
-                                  (insert-buffer-substring buf start end)
-                                  (kill-buffer buf)
-                                  modified))
-                            (message "(No changes need to be saved)")
-                            nil))
+    (restore-buffer-modified-p
+     (if (buffer-modified-p)
+         (let ((buf (generate-new-buffer " hexl"))
+               (name (buffer-name))
+               (start (point-min))
+               (end (point-max))
+               modified)
+           (with-current-buffer buf
+             (insert-buffer-substring name start end)
+             (set-buffer name)
+             (dehexlify-buffer)
+             ;; Prevent infinite recursion.
+             (let ((hexl-in-save-buffer t))
+               (save-buffer))
+             (setq modified (buffer-modified-p))
+             (delete-region (point-min) (point-max))
+             (insert-buffer-substring buf start end)
+             (kill-buffer buf)
+             modified))
+       (message "(No changes need to be saved)")
+       nil))
     ;; Return t to indicate we have saved t
     t))
 
 ;;;###autoload
 (defun hexl-find-file (filename)
-  "Edit file FILENAME in hexl-mode.
-Switch to a buffer visiting file FILENAME, creating one in none exists."
+  "Edit file FILENAME as a binary file in hex dump format.
+Switch to a buffer visiting file FILENAME, creating one if none exists,
+and edit the file in `hexl-mode'."
   (interactive
    (list
     (let ((completion-ignored-extensions nil))
@@ -366,7 +381,7 @@ With arg, don't unhexlify buffer."
            (original-point (1+ (hexl-current-address))))
        (dehexlify-buffer)
        (remove-hook 'write-contents-functions 'hexl-save-buffer t)
-       (set-buffer-modified-p modified)
+       (restore-buffer-modified-p modified)
        (goto-char original-point)
        ;; Maybe adjust point for the removed CR characters.
        (when (eq (coding-system-eol-type buffer-file-coding-system) 1)
@@ -375,6 +390,7 @@ With arg, don't unhexlify buffer."
          (or (bobp) (setq original-point (1+ original-point))))
        (goto-char original-point)))
 
+  (remove-hook 'before-revert-hook 'hexl-before-revert-hook t)
   (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)
@@ -382,8 +398,20 @@ With arg, don't unhexlify buffer."
 
   (if (and (boundp 'ruler-mode) ruler-mode (not hexl-mode-old-ruler-mode))
       (ruler-mode 0))
+  (when (boundp 'hexl-mode-old-ruler-function)
+    (setq ruler-mode-ruler-function hexl-mode-old-ruler-function))
+
   (if (and (boundp 'hl-line-mode) hl-line-mode (not hexl-mode-old-hl-line-mode))
       (hl-line-mode 0))
+  (when (boundp 'hexl-mode-old-hl-line-range-function)
+    (setq hl-line-range-function hexl-mode-old-hl-line-range-function))
+  (when (boundp 'hexl-mode-old-hl-line-face)
+    (setq hl-line-face hexl-mode-old-hl-line-face))
+
+  (when (boundp 'hexl-mode-old-eldoc-documentation-function)
+    (setq eldoc-documentation-function
+         hexl-mode-old-eldoc-documentation-function))
+
   (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)
@@ -402,7 +430,7 @@ Ask the user for confirmation."
            (original-point (1+ (hexl-current-address))))
        (dehexlify-buffer)
        (remove-hook 'write-contents-functions 'hexl-save-buffer t)
-       (set-buffer-modified-p modified)
+       (restore-buffer-modified-p modified)
        (goto-char original-point))))
 
 (defun hexl-current-address (&optional validate)
@@ -425,7 +453,7 @@ Ask the user for confirmation."
 
 (defun hexl-print-current-point-info ()
   "Return current hexl-address in string.
-This function is indented to be used as eldoc callback."
+This function is intended to be used as eldoc callback."
   (let ((addr (hexl-current-address)))
     (format "Current address is %d/0x%08x" addr addr)))
 
@@ -435,8 +463,8 @@ This function is indented to be used as eldoc callback."
   (+ (* (/ address 16) 68) 10 (point-min) (/ (* (% address 16) 5) 2)))
 
 (defun hexl-goto-address (address)
-  "Goto hexl-mode (decimal) address ADDRESS.
-Signal error if ADDRESS out of range."
+  "Go to hexl-mode (decimal) address ADDRESS.
+Signal error if ADDRESS is out of range."
   (interactive "nAddress: ")
   (if (or (< address 0) (> address hexl-max-address))
       (error "Out of hexl region"))
@@ -477,7 +505,7 @@ Signal error if HEX-ADDRESS is out of range."
   (hexl-goto-address (- (hexl-current-address) arg)))
 
 (defun hexl-forward-char (arg)
-  "Move right ARG bytes (left if ARG negative) in hexl-mode."
+  "Move to right ARG bytes (left if ARG negative) in hexl-mode."
   (interactive "p")
   (hexl-goto-address (+ (hexl-current-address) arg)))
 
@@ -516,7 +544,7 @@ Signal error if HEX-ADDRESS is out of range."
                       address)))
 
 (defun hexl-forward-short (arg)
-  "Move right ARG shorts (left if ARG negative) in hexl-mode."
+  "Move to right ARG shorts (left if ARG negative) in hexl-mode."
   (interactive "p")
   (hexl-backward-short (- arg)))
 
@@ -555,13 +583,13 @@ Signal error if HEX-ADDRESS is out of range."
                       address)))
 
 (defun hexl-forward-word (arg)
-  "Move right ARG words (left if ARG negative) in hexl-mode."
+  "Move to right ARG words (left if ARG negative) in hexl-mode."
   (interactive "p")
   (hexl-backward-word (- arg)))
 
 (defun hexl-previous-line (arg)
   "Move vertically up ARG lines [16 bytes] (down if ARG negative) in hexl-mode.
-If there is byte at the target address move to the last byte in that line."
+If there is no byte at the target address move to the last byte in that line."
   (interactive "p")
   (hexl-next-line (- arg)))
 
@@ -647,12 +675,12 @@ If there's no byte at the target address, move to the first or last line."
     (recenter 0)))
 
 (defun hexl-beginning-of-1k-page ()
-  "Go to beginning of 1k boundary."
+  "Go to beginning of 1KB boundary."
   (interactive)
   (hexl-goto-address (logand (hexl-current-address) -1024)))
 
 (defun hexl-end-of-1k-page ()
-  "Go to end of 1k boundary."
+  "Go to end of 1KB boundary."
   (interactive)
   (hexl-goto-address (let ((address (logior (hexl-current-address) 1023)))
                       (if (> address hexl-max-address)
@@ -687,17 +715,24 @@ You may also type octal digits, to insert a character with that code."
   "Convert a binary buffer to hexl format.
 This discards the buffer's undo information."
   (interactive)
-  (and buffer-undo-list
+  (and (consp buffer-undo-list)
        (or (y-or-n-p "Converting to hexl format discards undo info; ok? ")
-          (error "Aborted")))
-  (setq buffer-undo-list nil)
+          (error "Aborted"))
+       (setq buffer-undo-list nil))
   ;; Don't decode text in the ASCII part of `hexl' program output.
   (let ((coding-system-for-read 'raw-text)
        (coding-system-for-write buffer-file-coding-system)
        (buffer-undo-list t))
     (apply 'call-process-region (point-min) (point-max)
           (expand-file-name hexl-program exec-directory)
-          t t nil (split-string hexl-options))
+          t t nil
+           ;; Manually encode the args, otherwise they're encoded using
+           ;; coding-system-for-write (i.e. buffer-file-coding-system) which
+           ;; may not be what we want (e.g. utf-16 on a non-utf-16 system).
+           (mapcar (lambda (s)
+                     (if (not (multibyte-string-p s)) s
+                       (encode-coding-string s locale-coding-system)))
+                   (split-string hexl-options)))
     (if (> (point) (hexl-address-to-marker hexl-max-address))
        (hexl-goto-address hexl-max-address))))
 
@@ -705,10 +740,10 @@ This discards the buffer's undo information."
   "Convert a hexl format buffer to binary.
 This discards the buffer's undo information."
   (interactive)
-  (and buffer-undo-list
+  (and (consp buffer-undo-list)
        (or (y-or-n-p "Converting from hexl format discards undo info; ok? ")
-          (error "Aborted")))
-  (setq buffer-undo-list nil)
+          (error "Aborted"))
+       (setq buffer-undo-list nil))
   (let ((coding-system-for-write 'raw-text)
        (coding-system-for-read buffer-file-coding-system)
        (buffer-undo-list t))
@@ -916,26 +951,33 @@ Customize the variable `hexl-follow-ascii' to disable this feature."
            )))))
 
 (defun hexl-activate-ruler ()
-  "Activate `ruler-mode'"
+  "Activate `ruler-mode'."
   (require 'ruler-mode)
-  (set (make-local-variable 'ruler-mode-ruler-function) 
+  (unless (boundp 'hexl-mode-old-ruler-function)
+    (set (make-local-variable 'hexl-mode-old-ruler-function)
+        ruler-mode-ruler-function))
+  (set (make-local-variable 'ruler-mode-ruler-function)
        'hexl-mode-ruler)
   (ruler-mode 1))
 
 (defun hexl-follow-line ()
-  "Activate `hl-line-mode'"
-  (require 'frame)
+  "Activate `hl-line-mode'."
   (require 'hl-line)
-  (with-no-warnings
-    (set (make-local-variable 'hl-line-range-function)
-        'hexl-highlight-line-range)
-    (set (make-local-variable 'hl-line-face) 
-        'highlight))
+  (unless (boundp 'hexl-mode-old-hl-line-range-function)
+    (set (make-local-variable 'hexl-mode-old-hl-line-range-function)
+        hl-line-range-function))
+  (unless (boundp 'hexl-mode-old-hl-line-face)
+    (set (make-local-variable 'hexl-mode-old-hl-line-face)
+        hl-line-face))
+  (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'."
+  "Return the range of address region for the point.
+This function is assumed to be used as callback function for `hl-line-mode'."
   (cons
    (line-beginning-position)
    ;; 9 stands for (length "87654321:")
@@ -1009,7 +1051,8 @@ This function is assumed to be used as call back function for `hl-line-mode'."
   (define-key hexl-mode-map "\C-e" 'hexl-end-of-line)
   (define-key hexl-mode-map "\C-f" 'hexl-forward-char)
 
-  (if (not (eq (key-binding (char-to-string help-char)) 'help-command))
+  (if (not (memq (key-binding (char-to-string help-char))
+                 '(help-command ehelp-command)))
       (define-key hexl-mode-map (char-to-string help-char) 'undefined))
 
   (define-key hexl-mode-map "\C-k" 'undefined)
@@ -1067,7 +1110,44 @@ This function is assumed to be used as call back function for `hl-line-mode'."
   (define-key hexl-mode-map "\C-x\C-s" 'hexl-save-buffer)
   (define-key hexl-mode-map "\C-x\C-t" 'undefined))
 
+(easy-menu-define hexl-menu hexl-mode-map "Hexl Mode menu"
+  `("Hexl"
+    :help "Hexl-specific Features"
+
+    ["Backward short" hexl-backward-short
+     :help "Move to left a short"]
+    ["Forward short" hexl-forward-short
+     :help "Move to right a short"]
+    ["Backward word" hexl-backward-short
+     :help "Move to left a word"]
+    ["Forward word" hexl-forward-short
+     :help "Move to right a word"]
+    "-"
+    ["Beginning of 512b page" hexl-beginning-of-512b-page
+     :help "Go to beginning of 512 byte boundary"]
+    ["End of 512b page" hexl-end-of-512b-page
+     :help "Go to end of 512 byte boundary"]
+    ["Beginning of 1K page" hexl-beginning-of-1k-page
+     :help "Go to beginning of 1KB boundary"]
+    ["End of 1K page" hexl-end-of-1k-page
+     :help "Go to end of 1KB boundary"]
+    "-"
+    ["Go to address" hexl-goto-address
+     :help "Go to hexl-mode (decimal) address"]
+    ["Go to address" hexl-goto-hex-address
+     :help "Go to hexl-mode (hex string) address"]
+    "-"
+    ["Insert decimal char" hexl-insert-decimal-char
+     :help "Insert a character given by its decimal code"]
+    ["Insert hex char" hexl-insert-hex-char
+     :help "Insert a character given by its hexadecimal code"]
+    ["Insert octal char" hexl-insert-octal-char
+     :help "Insert a character given by its octal code"]
+    "-"
+    ["Exit hexl mode" hexl-mode-exit
+     :help "Exit hexl mode returning to previous mode"]))
+
 (provide 'hexl)
 
-;;; arch-tag: d5a7aa8a-9bce-480b-bcff-6c4c7ca5ea4a
+;; arch-tag: d5a7aa8a-9bce-480b-bcff-6c4c7ca5ea4a
 ;;; hexl.el ends here