-;;; hexl.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 -*- lexical-binding: t -*-
-;; Copyright (C) 1989, 1994, 1998, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 1994, 1998, 2001-2012 Free Software Foundation, Inc.
;; Author: Keith Gabryelski <ag@wheaties.ai.mit.edu>
;; Maintainer: FSF
;;; Code:
(require 'eldoc)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;
;; vars here
"Edit a file in a hex dump format using the hexl filter."
:group 'data)
+(defcustom hexl-bits 16
+ "The bit grouping that hexl will use."
+ :type '(choice (const 8 )
+ (const 16)
+ (const 32)
+ (const 64))
+ :group 'hexl
+ :version "24.3")
(defcustom hexl-program "hexl"
"The program that will hexlify and dehexlify its stdin.
(defcustom hexl-options (format "-hex %s" hexl-iso)
"Space separated options to `hexl-program' that suit your needs.
-Quoting cannot be used, so the arguments cannot themselves contain spaces."
+Quoting cannot be used, so the arguments cannot themselves contain spaces.
+If you wish to set the `-group-by-X-bits' options, set `hexl-bits' instead,
+as that will override any bit grouping options set here."
:type 'string
:group 'hexl)
(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-mode-old-revert-buffer-function)
+(defvar hexl-mode--old-var-vals ())
+(make-variable-buffer-local 'hexl-mode--old-var-vals)
(defvar hexl-ascii-overlay nil
"Overlay used to highlight ASCII element corresponding to current point.")
(2 'hexl-ascii-region t t)))
"Font lock keywords used in `hexl-mode'.")
+(defun hexl-rulerize (string bits)
+ (let ((size (/ bits 4)) (strlen (length string)) (pos 0) (ruler ""))
+ (while (< pos strlen)
+ (setq ruler (concat ruler " " (substring string pos (+ pos size))))
+ (setq pos (+ pos size)))
+ (substring ruler 1) ))
+
+(defvar hexl-rulers
+ (mapcar
+ (lambda (bits)
+ (cons bits
+ (concat " 87654321 "
+ (hexl-rulerize "00112233445566778899aabbccddeeff" bits)
+ " 0123456789abcdef")))
+ '(8 16 32 64)))
;; routines
(put 'hexl-mode 'mode-class 'special)
+;; 10 chars for the "address: "
+;; 32 chars for the hexlified bytes
+;; 1 char for the space
+;; 16 chars for the character display
+;; X chars for the spaces (128 bits divided by the hexl-bits)
+;; 1 char for the newline.
+(defun hexl-line-displen ()
+ "The length of a hexl display line (varies with `hexl-bits')."
+ (+ 60 (/ 128 (or hexl-bits 16))))
+
+(defun hexl-mode--minor-mode-p (var)
+ (memq var '(ruler-mode hl-line-mode)))
+
+(defun hexl-mode--setq-local (var val)
+ ;; `var' can be either a symbol or a pair, in which case the `car'
+ ;; is the getter function and the `cdr' is the corresponding setter.
+ (unless (or (member var hexl-mode--old-var-vals)
+ (assoc var hexl-mode--old-var-vals))
+ (push (if (or (consp var) (boundp var))
+ (cons var
+ (if (consp var) (funcall (car var)) (symbol-value var)))
+ var)
+ hexl-mode--old-var-vals))
+ (cond
+ ((consp var) (funcall (cdr var) val))
+ ((hexl-mode--minor-mode-p var) (funcall var (if val 1 -1)))
+ (t (set (make-local-variable var) val))))
+
;;;###autoload
(defun hexl-mode (&optional arg)
"\\<hexl-mode-map>A mode for editing binary files in hex dump format.
Each line in the buffer has an \"address\" (displayed in hexadecimal)
representing the offset into the file that the characters on this line
are at and 16 characters from the file (displayed as hexadecimal
-values grouped every 16 bits) and as their ASCII values.
+values grouped every `hexl-bits' bits) and as their ASCII values.
If any of the characters (displayed as ASCII characters) are
unprintable (control or meta characters) they will be replaced as
(hexlify-buffer)
(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)))
+ (+ (* (/ (1- (buffer-size)) (hexl-line-displen)) 16) 15))
(condition-case nil
(hexl-goto-address original-point)
(error nil)))
;; 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)
-
- (make-local-variable 'hexl-mode-old-mode-name)
- (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)
+ (hexl-mode--setq-local '(current-local-map . use-local-map) hexl-mode-map)
- (make-local-variable 'hexl-mode-old-ruler-mode)
- (setq hexl-mode-old-ruler-mode
- (and (boundp 'ruler-mode) ruler-mode))
+ (hexl-mode--setq-local 'mode-name "Hexl")
+ (hexl-mode--setq-local 'isearch-search-fun-function
+ 'hexl-isearch-search-function)
+ (hexl-mode--setq-local 'major-mode 'hexl-mode)
- (make-local-variable 'hexl-mode-old-hl-line-mode)
- (setq hexl-mode-old-hl-line-mode
- (and (boundp 'hl-line-mode) hl-line-mode))
-
- (make-local-variable 'hexl-mode-old-syntax-table)
- (setq hexl-mode-old-syntax-table (syntax-table))
- (set-syntax-table (standard-syntax-table))
+ (hexl-mode--setq-local '(syntax-table . set-syntax-table)
+ (standard-syntax-table))
(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)
- (make-local-variable 'require-final-newline)
- (setq require-final-newline nil)
+ (hexl-mode--setq-local 'require-final-newline nil)
+
- (make-local-variable 'hexl-mode-old-font-lock-keywords)
- (setq hexl-mode-old-font-lock-keywords font-lock-defaults)
- (setq font-lock-defaults '(hexl-font-lock-keywords t))
+ (hexl-mode--setq-local 'font-lock-defaults '(hexl-font-lock-keywords t))
- (make-local-variable 'hexl-mode-old-revert-buffer-function)
- (setq hexl-mode-old-revert-buffer-function revert-buffer-function)
- (setq revert-buffer-function 'hexl-revert-buffer-function)
+ (hexl-mode--setq-local 'revert-buffer-function
+ #'hexl-revert-buffer-function)
(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)
+ (hexl-mode--setq-local 'eldoc-documentation-function
+ #'hexl-print-current-point-info)
(eldoc-add-command-completions "hexl-")
(eldoc-remove-command "hexl-save-buffer"
"hexl-current-address")
" \\(?: .+\n[a-f0-9]+: \\)?"))
textre))
bound noerror count))
- (let ((isearch-search-fun-function nil))
- (isearch-search-fun))))
+ (isearch-search-fun-default)))
(defvar hexl-in-save-buffer nil)
(let ((completion-ignored-extensions nil))
(read-file-name "Filename: " nil nil 'ret-must-match))))
;; Ignore the user's setting of default major-mode.
- (letf (((default-value 'major-mode) 'fundamental-mode))
+ (cl-letf (((default-value 'major-mode) 'fundamental-mode))
(find-file-literally filename))
(if (not (eq major-mode 'hexl-mode))
(hexl-mode)))
-(defun hexl-revert-buffer-function (ignore-auto noconfirm)
+(defun hexl-revert-buffer-function (_ignore-auto _noconfirm)
(let ((coding-system-for-read 'no-conversion)
revert-buffer-function)
;; Call the original `revert-buffer' without code conversion; also
(remove-hook 'post-command-hook 'hexl-follow-ascii-find t)
(setq hexl-ascii-overlay nil)
- (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)
- (use-local-map hexl-mode-old-local-map)
- (set-syntax-table hexl-mode-old-syntax-table)
- (setq font-lock-defaults hexl-mode-old-font-lock-keywords)
- (setq major-mode hexl-mode-old-major-mode)
- (setq revert-buffer-function hexl-mode-old-revert-buffer-function)
+ (let ((mms ()))
+ (dolist (varval hexl-mode--old-var-vals)
+ (let* ((bound (consp varval))
+ (var (if bound (car varval) varval))
+ (val (cdr-safe varval)))
+ (cond
+ ((consp var) (funcall (cdr var) val))
+ ((hexl-mode--minor-mode-p var) (push (cons var val) mms))
+ (bound (set (make-local-variable var) val))
+ (t (kill-local-variable var)))))
+ (kill-local-variable 'hexl-mode--old-var-vals)
+ ;; Enable/disable minor modes. Do it after having reset the other vars,
+ ;; since some of them may affect the minor modes.
+ (dolist (mm mms)
+ (funcall (car mm) (if (cdr mm) 1 -1))))
+
(force-mode-line-update))
(defun hexl-maybe-dehexlify-buffer ()
(defun hexl-current-address (&optional validate)
"Return current hexl-address."
(interactive)
- (let ((current-column (- (% (- (point) (point-min) -1) 68) 11))
+ (let ((current-column
+ (- (% (- (point) (point-min) -1) (hexl-line-displen)) 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) (point-min) -1) 68) 16)
- (if (>= current-column 41)
- (- current-column 41)
- (/ (- current-column (/ current-column 5)) 2))))
+ (+ (* (/ (- (point) (point-min) -1)
+ (hexl-line-displen)) 16)
+ (if (>= current-column (- (hexl-ascii-start-column) 10))
+ (- current-column (- (hexl-ascii-start-column) 10))
+ (/ (- current-column
+ (/ current-column (1+ (/ hexl-bits 4)))) 2))))
(when (called-interactively-p 'interactive)
(message "Current address is %d/0x%08x" hexl-address hexl-address))
hexl-address))
(let ((addr (hexl-current-address)))
(format "Current address is %d/0x%08x" addr addr)))
+(defun hexl-ascii-start-column ()
+ "Column at which the ascii portion of the hexl display starts."
+ (+ 43 (/ 128 hexl-bits)))
+
(defun hexl-address-to-marker (address)
"Return buffer position for ADDRESS."
(interactive "nAddress: ")
- (+ (* (/ address 16) 68) 10 (point-min) (/ (* (% address 16) 5) 2)))
+ (let ((N (* (% address 16) 2)))
+ (+ (* (/ address 16) (hexl-line-displen)) ; hexl line no * display length
+ 10 ; 10 chars for the "address: " prefix
+ (point-min) ; base offset (point usually starts at 1, not 0)
+ (+ N (/ N (/ hexl-bits 4))) )) ) ; char offset into hexl display line
(defun hexl-goto-address (address)
"Go to hexl-mode (decimal) address ADDRESS.
(progn
(setq arg (- arg))
(while (> arg 0)
- (if (not (equal address (logior address 3)))
- (if (> address hexl-max-address)
- (progn
- (message "End of buffer.")
- (setq address hexl-max-address))
- (setq address (logior address 3)))
- (if (> address hexl-max-address)
- (progn
- (message "End of buffer.")
- (setq address hexl-max-address))
- (setq address (+ address 4))))
+ (setq address
+ (if (> address hexl-max-address)
+ (progn
+ (message "End of buffer.")
+ hexl-max-address)
+ (if (equal address (logior address 3))
+ (+ address 4)
+ (logior address 3))))
(setq arg (1- arg)))
- (if (> address hexl-max-address)
- (progn
- (message "End of buffer.")
- (setq address hexl-max-address))
- (setq address (logior address 3))))
+ (setq address
+ (if (> address hexl-max-address)
+ (progn
+ (message "End of buffer.")
+ hexl-max-address)
+ (logior address 3))))
(while (> arg 0)
(if (not (equal address (logand address -4)))
(setq address (logand address -4))
(progn
(setq arg (- arg))
(while (> arg 0)
- (if (not (equal address (logior address 7)))
- (if (> address hexl-max-address)
- (progn
- (message "End of buffer.")
- (setq address hexl-max-address))
- (setq address (logior address 7)))
- (if (> address hexl-max-address)
- (progn
- (message "End of buffer.")
- (setq address hexl-max-address))
- (setq address (+ address 8))))
+ (setq address
+ (if (> address hexl-max-address)
+ (progn
+ (message "End of buffer.")
+ hexl-max-address)
+ (if (equal address (logior address 7))
+ (+ address 8)
+ (logior address 7))))
(setq arg (1- arg)))
- (if (> address hexl-max-address)
- (progn
- (message "End of buffer.")
- (setq address hexl-max-address))
- (setq address (logior address 7))))
+ (setq address
+ (if (> address hexl-max-address)
+ (progn
+ (message "End of buffer.")
+ hexl-max-address)
+ (logior address 7))))
(while (> arg 0)
(if (not (equal address (logand address -8)))
(setq address (logand address -8))
(defun hexl-beginning-of-line ()
"Goto beginning of line in hexl mode."
(interactive)
- (goto-char (+ (* (/ (point) 68) 68) 11)))
+ (goto-char (+ (* (/ (point) (hexl-line-displen)) (hexl-line-displen)) 11)))
(defun hexl-end-of-line ()
"Goto end of line in hexl mode."
(defun hexl-scroll-down (arg)
"Scroll hexl buffer window upward ARG lines; or near full window if no ARG."
(interactive "P")
- (if (null arg)
- (setq arg (1- (window-height)))
- (setq arg (prefix-numeric-value arg)))
+ (setq arg (if (null arg)
+ (1- (window-height))
+ (prefix-numeric-value arg)))
(hexl-scroll-up (- arg)))
(defun hexl-scroll-up (arg)
"Scroll hexl buffer window upward ARG lines; or near full window if no ARG.
If there's no byte at the target address, move to the first or last line."
(interactive "P")
- (if (null arg)
- (setq arg (1- (window-height)))
- (setq arg (prefix-numeric-value arg)))
+ (setq arg (if (null arg)
+ (1- (window-height))
+ (prefix-numeric-value arg)))
(let* ((movement (* arg 16))
(address (hexl-current-address))
(dest (+ address movement)))
(defun hexl-end-of-1k-page ()
"Go to end of 1KB boundary."
(interactive)
- (hexl-goto-address (let ((address (logior (hexl-current-address) 1023)))
- (if (> address hexl-max-address)
- (setq address hexl-max-address))
- address)))
+ (hexl-goto-address
+ (max hexl-max-address (logior (hexl-current-address) 1023))))
(defun hexl-beginning-of-512b-page ()
"Go to beginning of 512 byte boundary."
(defun hexl-end-of-512b-page ()
"Go to end of 512 byte boundary."
(interactive)
- (hexl-goto-address (let ((address (logior (hexl-current-address) 511)))
- (if (> address hexl-max-address)
- (setq address hexl-max-address))
- address)))
+ (hexl-goto-address
+ (max hexl-max-address (logior (hexl-current-address) 511))))
(defun hexl-quoted-insert (arg)
"Read next input character and insert it.
;00000000: 0011 2233 4455 6677 8899 aabb ccdd eeff 0123456789ABCDEF
+(defun hexl-options (&optional test)
+ "Combine `hexl-bits' with `hexl-options', altering `hexl-options' as needed
+to produce the command line options to pass to the hexl command."
+ (let ((opts (or test hexl-options)))
+ (when (memq hexl-bits '(8 16 32 64))
+ (when (string-match "\\(.*\\)-group-by-[0-9]+-bits\\(.*\\)" opts)
+ (setq opts (concat (match-string 1 opts)
+ (match-string 2 opts))))
+ (setq opts (format "%s -group-by-%d-bits " opts hexl-bits)) )
+ opts))
+
;;;###autoload
(defun hexlify-buffer ()
"Convert a binary buffer to hexl format.
(mapcar (lambda (s)
(if (not (multibyte-string-p s)) s
(encode-coding-string s locale-coding-system)))
- (split-string hexl-options)))
+ (split-string (hexl-options))))
(if (> (point) (hexl-address-to-marker hexl-max-address))
(hexl-goto-address hexl-max-address))))
(buffer-undo-list t))
(apply 'call-process-region (point-min) (point-max)
(expand-file-name hexl-program exec-directory)
- t t nil "-de" (split-string hexl-options))))
+ t t nil "-de" (split-string (hexl-options)))))
(defun hexl-char-after-point ()
"Return char for ASCII hex digits at point."
(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)
- 10 (point-min)
- (* 2 (% address 16))
- (/ (% address 16) 2)))
+ (let ((hex-position (hexl-address-to-marker address))
(ascii-position
- (+ (* (/ address 16) 68) 51 (point-min) (% address 16)))
+ (+ (* (/ address 16) (hexl-line-displen))
+ (hexl-ascii-start-column)
+ (point-min)
+ (% address 16)))
at-ascii-position)
(if (= (point) ascii-position)
(setq at-ascii-position t))
(if at-ascii-position
(progn
(beginning-of-line)
- (forward-char 51)
+ (forward-char (hexl-ascii-start-column))
(forward-char (% address 16)))))
(setq num (1- num)))))
(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))
+ (hexl-mode--setq-local 'ruler-mode-ruler-function
+ #'hexl-mode-ruler)
+ (hexl-mode--setq-local 'ruler-mode t))
(defun hexl-follow-line ()
"Activate `hl-line-mode'."
(require 'hl-line)
- (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))
+ (hexl-mode--setq-local 'hl-line-range-function
+ #'hexl-highlight-line-range)
+ (hexl-mode--setq-local 'hl-line-face 'highlight)
+ (hexl-mode--setq-local 'hl-line-mode t))
(defun hexl-highlight-line-range ()
"Return the range of address region for the point.
(defun hexl-follow-ascii-find ()
"Find and highlight the ASCII element corresponding to current point."
- (let ((pos (+ 51
+ (let ((pos (+ (hexl-ascii-start-column)
(- (point) (current-column))
(mod (hexl-current-address) 16))))
(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")
+ (s (cdr (assq hexl-bits hexl-rulers)))
(pos 0))
(set-text-properties 0 (length s) nil s)
;; Turn spaces in the header into stretch specs so they work
`(space :align-to ,(1- pos))
s))
;; Highlight the current column.
- (put-text-property (+ 11 (/ (* 5 highlight) 2))
- (+ 13 (/ (* 5 highlight) 2))
- 'face 'highlight s)
+ (let ( (offset (+ (* 2 highlight) (/ (* 8 highlight) hexl-bits))) )
+ (put-text-property (+ 11 offset) (+ 13 offset) 'face 'highlight s))
;; Highlight the current ascii column
- (put-text-property (+ 13 39 highlight) (+ 13 40 highlight)
- 'face 'highlight s)
+ (put-text-property (+ (hexl-ascii-start-column) highlight 1)
+ (+ (hexl-ascii-start-column) highlight 2)
+ 'face 'highlight s)
s))
;; startup stuff.
(provide 'hexl)
-;; arch-tag: d5a7aa8a-9bce-480b-bcff-6c4c7ca5ea4a
;;; hexl.el ends here