X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/cfc2051d0ed5a268528a647ab0911a2f5cc451de..2657775f8bef3beffa6b1bd745b0ef42144ec369:/lisp/hexl.el diff --git a/lisp/hexl.el b/lisp/hexl.el index 1e724aa418..2cdd449af3 100644 --- a/lisp/hexl.el +++ b/lisp/hexl.el @@ -1,7 +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, -;; 2005, 2006 Free Software Foundation, Inc. +;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Keith Gabryelski ;; Maintainer: FSF @@ -9,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 @@ -20,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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -87,12 +85,12 @@ Quoting cannot be used, so the arguments cannot themselves contain spaces." (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-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 @@ -100,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.") @@ -169,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). @@ -207,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) (restore-buffer-modified-p modified)) - (make-local-variable 'hexl-max-address) - (setq hexl-max-address max-address) + (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))) @@ -276,15 +278,19 @@ 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-") @@ -314,10 +320,11 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode. (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) @@ -351,8 +358,9 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode. ;;;###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)) @@ -382,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) @@ -389,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) @@ -442,8 +463,8 @@ This function is intended 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")) @@ -484,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))) @@ -523,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))) @@ -562,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))) @@ -654,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) @@ -694,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)))) @@ -712,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)) @@ -807,7 +835,7 @@ Interactively, with a numeric argument, insert this character that many times. Non-ASCII characters are first encoded with `buffer-file-coding-system', and their encoded form is inserted byte by byte." (interactive "p") - (hexl-insert-multibyte-char last-command-char arg)) + (hexl-insert-multibyte-char last-command-event arg)) (defun hexl-insert-char (ch num) "Insert the character CH NUM times in a hexl buffer. @@ -925,24 +953,31 @@ Customize the variable `hexl-follow-ascii' to disable this feature." (defun hexl-activate-ruler () "Activate `ruler-mode'." (require 'ruler-mode) + (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) (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 region for the point. -This function is assumed to be used as call back function for `hl-line-mode'." +This function is assumed to be used as callback function for `hl-line-mode'." (cons (line-beginning-position) ;; 9 stands for (length "87654321:") @@ -1075,6 +1110,43 @@ 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