X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b9a4b5011e4804cc372fe3cba4b45ebb3ccac489..3da6a0264b8004a0d8a9062f3b53c522ac49335a:/lisp/hexl.el diff --git a/lisp/hexl.el b/lisp/hexl.el index a38e12366e..1ef4a0a4c5 100644 --- a/lisp/hexl.el +++ b/lisp/hexl.el @@ -1,8 +1,10 @@ -;;; hexl-mode.el --- edit a file in a hex dump format using the hexl filter. +;;; hexl.el --- edit a file in a hex dump format using the hexl filter. -;; Copyright (C) 1989 Free Software Foundation, Inc. +;; Copyright (C) 1989, 1994 Free Software Foundation, Inc. ;; Author: Keith Gabryelski +;; Maintainer: FSF +;; Keywords: data ;; This file is part of GNU Emacs. @@ -22,6 +24,12 @@ ;;; Commentary: +;; This package implements a major mode for editing binary files. It uses +;; 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'. +;; ;; This may be useful in your .emacs: ;; ;; (autoload 'hexl-find-file "hexl" @@ -45,9 +53,9 @@ ;; (defvar hexl-program "hexl" - "The program that will hexlify and de-hexlify its stdin. -`hexl-program' will always be concated with `hexl-options' -and \"-de\" when dehexlfying a buffer.") + "The program that will hexlify and dehexlify its stdin. +`hexl-program' will always be concatenated with `hexl-options' +and \"-de\" when dehexlifying a buffer.") (defvar hexl-iso "" "If your emacs can handle ISO characters, this should be set to @@ -56,25 +64,32 @@ and \"-de\" when dehexlfying a buffer.") (defvar hexl-options (format "-hex %s" hexl-iso) "Options to hexl-program that suit your needs.") -(defvar hexlify-command (format "%s %s" hexl-program hexl-options) - "The command to use to hexlify a buffer. It is the concatination of -`hexl-program' and `hexl-options'.") +(defvar hexlify-command + (format "%s%s %s" exec-directory hexl-program hexl-options) + "The command to use to hexlify a buffer.") -(defvar dehexlify-command (format "%s -de %s" hexl-program hexl-options) - "The command to use to unhexlify a buffer. It is the concatination of -`hexl-program', the option \"-de\", and `hexl-options'.") +(defvar dehexlify-command + (format "%s%s -de %s" exec-directory hexl-program hexl-options) + "The command to use to unhexlify a buffer.") (defvar hexl-max-address 0 "Maximum offset into hexl buffer.") (defvar hexl-mode-map nil) +(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-require-final-newline) +(defvar hexl-mode-old-syntax-table) + ;; routines ;;;###autoload (defun hexl-mode (&optional arg) "\\ -A major mode for editting binary files in hex dump format. +A major mode for editing binary files in hex dump format. This function automatically converts a buffer into the hexl format using the function `hexlify-buffer'. @@ -145,8 +160,10 @@ You can use \\[hexl-find-file] to visit a file in hexl-mode. \\[describe-bindings] for advanced commands." (interactive "p") (if (eq major-mode 'hexl-mode) - (error "You are already in hexl mode.") - (kill-all-local-variables) + (error "You are already in hexl mode") + + ;; We do not turn off the old major mode; instead we just + ;; override most of it. That way, we can restore it perfectly. (make-local-variable 'hexl-mode-old-local-map) (setq hexl-mode-old-local-map (current-local-map)) (use-local-map hexl-mode-map) @@ -159,55 +176,86 @@ You can use \\[hexl-find-file] to visit a file in hexl-mode. (setq hexl-mode-old-major-mode major-mode) (setq major-mode 'hexl-mode) + (make-local-variable 'hexl-mode-old-syntax-table) + (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) - (setq write-contents-hooks - (cons 'hexl-save-buffer write-contents-hooks)) + (add-hook 'write-contents-hooks 'hexl-save-buffer) + + (make-local-variable 'hexl-mode-old-require-final-newline) + (setq hexl-mode-old-require-final-newline require-final-newline) + (make-local-variable 'require-final-newline) + (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) + + (make-local-variable 'hexl-max-address) (let ((modified (buffer-modified-p)) - (read-only buffer-read-only) + (inhibit-read-only t) (original-point (1- (point)))) + (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 + ;; if no argument then we guess at hexl-max-address (setq hexl-max-address (+ (* (/ (1- (buffer-size)) 68) 16) 15)) - (setq buffer-read-only nil) (setq hexl-max-address (1- (buffer-size))) (hexlify-buffer) (set-buffer-modified-p modified) - (setq buffer-read-only read-only) (hexl-goto-address original-point))))) +(defun hexl-after-revert-hook () + (hexlify-buffer) + (set-buffer-modified-p nil)) + +(defvar hexl-in-save-buffer nil) + (defun hexl-save-buffer () "Save a hexl format buffer as binary in visited file if modified." (interactive) - (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) - (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) + (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) + (buffer-file-type t)) ; for ms-dos + (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." (interactive "fFilename: ") - (find-file filename) + (if (or (eq system-type 'ms-dos) (eq system-type 'windows-nt)) + (find-file-binary filename) + (find-file filename)) (if (not (eq major-mode 'hexl-mode)) (hexl-mode))) @@ -217,27 +265,50 @@ With arg, don't unhexlify buffer." (interactive "p") (if (or (eq arg 1) (not arg)) (let ((modified (buffer-modified-p)) - (read-only buffer-read-only) + (inhibit-read-only t) (original-point (1+ (hexl-current-address)))) - (setq buffer-read-only nil) (dehexlify-buffer) + (remove-hook 'write-contents-hook 'hexl-save-buffer) (set-buffer-modified-p modified) - (setq buffer-read-only read-only) (goto-char original-point))) + + (remove-hook 'after-revert-hook 'hexl-after-revert-hook t) + (remove-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer t) + + (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) (use-local-map hexl-mode-old-local-map) + (set-syntax-table hexl-mode-old-syntax-table) (setq major-mode hexl-mode-old-major-mode) -;; Kludge to update mode-line - (switch-to-buffer (current-buffer)) -) + (force-mode-line-update)) + +(defun hexl-maybe-dehexlify-buffer () + "Convert a hexl format buffer to binary. +Ask the user for confirmation." + (if (y-or-n-p "Convert contents back to binary format? ") + (let ((modified (buffer-modified-p)) + (inhibit-read-only t) + (original-point (1+ (hexl-current-address)))) + (dehexlify-buffer) + (remove-hook 'write-contents-hook 'hexl-save-buffer) + (set-buffer-modified-p modified) + (goto-char original-point)))) -(defun hexl-current-address () +(defun hexl-current-address (&optional validate) "Return current hexl-address." (interactive) (let ((current-column (- (% (point) 68) 11)) (hexl-address 0)) - (setq hexl-address (+ (* (/ (point) 68) 16) - (/ (- current-column (/ current-column 5)) 2))) + (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) + (if (>= current-column 41) + (- current-column 41) + (/ (- current-column (/ current-column 5)) 2)))) hexl-address)) (defun hexl-address-to-marker (address) @@ -247,7 +318,6 @@ With arg, don't unhexlify buffer." (defun hexl-goto-address (address) "Goto hexl-mode (decimal) address ADDRESS. - Signal error if ADDRESS out of range." (interactive "nAddress: ") (if (or (< address 0) (> address hexl-max-address)) @@ -256,7 +326,6 @@ Signal error if ADDRESS out of range." (defun hexl-goto-hex-address (hex-address) "Go to hexl-mode address (hex string) HEX-ADDRESS. - Signal error if HEX-ADDRESS is out of range." (interactive "sHex Address: ") (hexl-goto-address (hexl-hex-string-to-integer hex-address))) @@ -448,12 +517,12 @@ With prefix arg N, puts point N bytes of the way from the true beginning." (recenter 0)))) (defun hexl-beginning-of-1k-page () - "Goto to beginning of 1k boundry." + "Go to beginning of 1k boundary." (interactive) (hexl-goto-address (logand (hexl-current-address) -1024))) (defun hexl-end-of-1k-page () - "Goto to end of 1k boundry." + "Go to end of 1k boundary." (interactive) (hexl-goto-address (let ((address (logior (hexl-current-address) 1023))) (if (> address hexl-max-address) @@ -461,12 +530,12 @@ With prefix arg N, puts point N bytes of the way from the true beginning." address))) (defun hexl-beginning-of-512b-page () - "Goto to beginning of 512 byte boundry." + "Go to beginning of 512 byte boundary." (interactive) (hexl-goto-address (logand (hexl-current-address) -512))) (defun hexl-end-of-512b-page () - "Goto to end of 512 byte boundry." + "Go to end of 512 byte boundary." (interactive) (hexl-goto-address (let ((address (logior (hexl-current-address) 511))) (if (> address hexl-max-address) @@ -482,21 +551,25 @@ You may also type up to 3 octal digits, to insert a character with that code" ;00000000: 0011 2233 4455 6677 8899 aabb ccdd eeff 0123456789ABCDEF +;;;###autoload (defun hexlify-buffer () - "Convert a binary buffer to hexl format" + "Convert a binary buffer to hexl format." (interactive) - (shell-command-on-region (point-min) (point-max) hexlify-command t)) + (let ((binary-process-output nil) ; for Ms-Dos + (binary-process-input t)) + (shell-command-on-region (point-min) (point-max) hexlify-command t))) (defun dehexlify-buffer () "Convert a hexl format buffer to binary." (interactive) - (shell-command-on-region (point-min) (point-max) dehexlify-command t)) + (let ((binary-process-output t) ; for Ms-Dos + (binary-process-input nil)) + (shell-command-on-region (point-min) (point-max) dehexlify-command t))) (defun hexl-char-after-point () "Return char for ASCII hex digits at point." - (setq lh (char-after (point))) - (setq rh (char-after (1+ (point)))) - (hexl-htoi lh rh)) + (hexl-htoi (char-after (point)) + (char-after (1+ (point))))) (defun hexl-htoi (lh rh) "Hex (char) LH (char) RH to integer." @@ -535,17 +608,32 @@ You may also type up to 3 octal digits, to insert a character with that code" (defun hexl-insert-char (ch num) "Insert a character in a hexl buffer." - (let ((address (hexl-current-address))) + (let ((address (hexl-current-address t))) (while (> num 0) - (delete-char 2) - (insert (format "%02x" ch)) - (goto-char - (+ (* (/ address 16) 68) 52 (% address 16))) - (delete-char 1) - (insert (hexl-printable-character ch)) - (if (eq address hexl-max-address) - (hexl-goto-address address) - (hexl-goto-address (1+ address))) + (let ((hex-position + (+ (* (/ address 16) 68) + 11 + (* 2 (% address 16)) + (/ (% address 16) 2))) + (ascii-position + (+ (* (/ address 16) 68) 52 (% address 16))) + at-ascii-position) + (if (= (point) ascii-position) + (setq at-ascii-position t)) + (goto-char hex-position) + (delete-char 2) + (insert (format "%02x" ch)) + (goto-char ascii-position) + (delete-char 1) + (insert (hexl-printable-character ch)) + (or (eq address hexl-max-address) + (setq address (1+ address))) + (hexl-goto-address address) + (if at-ascii-position + (progn + (beginning-of-line) + (forward-char 51) + (forward-char (% address 16))))) (setq num (1- num))))) ;; hex conversion @@ -580,6 +668,15 @@ You may also type up to 3 octal digits, to insert a character with that code" nil (setq hexl-mode-map (make-sparse-keymap)) + (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) + (define-key hexl-mode-map [down] 'hexl-next-line) + (define-key hexl-mode-map [M-left] 'hexl-backward-short) + (define-key hexl-mode-map [M-right] 'hexl-forward-short) + (define-key hexl-mode-map [next] 'hexl-scroll-up) + (define-key hexl-mode-map [prev] 'hexl-scroll-down) + (define-key hexl-mode-map "\C-a" 'hexl-beginning-of-line) (define-key hexl-mode-map "\C-b" 'hexl-backward-char) (define-key hexl-mode-map "\C-d" 'undefined) @@ -587,7 +684,7 @@ You may also type up to 3 octal digits, to insert a character with that code" (define-key hexl-mode-map "\C-f" 'hexl-forward-char) (if (not (eq (key-binding (char-to-string help-char)) 'help-command)) - (define-key hexl-mode-map help-char 'undefined)) + (define-key hexl-mode-map (char-to-string help-char) 'undefined)) (define-key hexl-mode-map "\C-i" 'hexl-self-insert-command) (define-key hexl-mode-map "\C-j" 'hexl-self-insert-command)