(exec-suffixes): Initialize to a system-dependent value.
[bpt/emacs.git] / lisp / hexl.el
CommitLineData
55535639 1;;; hexl.el --- edit a file in a hex dump format using the hexl filter
e5167999 2
48f56596 3;; Copyright (C) 1989, 1994, 1998, 2001 Free Software Foundation, Inc.
a2535589 4
3a801d0c 5;; Author: Keith Gabryelski <ag@wheaties.ai.mit.edu>
b7f66977
RS
6;; Maintainer: FSF
7;; Keywords: data
3a801d0c 8
a2535589
JA
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
e5167999 13;; the Free Software Foundation; either version 2, or (at your option)
a2535589
JA
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
b578f267
EN
22;; along with GNU Emacs; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24;; Boston, MA 02111-1307, USA.
a2535589 25
e5167999
ER
26;;; Commentary:
27
e41b2db1
ER
28;; This package implements a major mode for editing binary files. It uses
29;; a program called hexl, supplied with the GNU Emacs distribution, that
30;; can filter a binary into an editable format or from the format back into
31;; binary. For full instructions, invoke `hexl-mode' on an empty buffer and
32;; do `M-x describe-mode'.
33;;
a2535589
JA
34;; This may be useful in your .emacs:
35;;
36;; (autoload 'hexl-find-file "hexl"
37;; "Edit file FILENAME in hexl-mode." t)
38;;
39;; (define-key global-map "\C-c\C-h" 'hexl-find-file)
40;;
41;; NOTE: Remember to change HEXL-PROGRAM or HEXL-OPTIONS if needed.
42;;
43;; Currently hexl only supports big endian hex output with 16 bit
44;; grouping.
45;;
46;; -iso in `hexl-options' will allow iso characters to display in the
47;; ASCII region of the screen (if your emacs supports this) instead of
48;; changing them to dots.
49
e5167999
ER
50;;; Code:
51
a2535589
JA
52;;
53;; vars here
54;;
55
00ed33e7
RS
56(defgroup hexl nil
57 "Edit a file in a hex dump format using the hexl filter."
58 :group 'data)
59
60
61(defcustom hexl-program "hexl"
65e5f4bc 62 "The program that will hexlify and dehexlify its stdin.
57f07931 63`hexl-program' will always be concatenated with `hexl-options'
00ed33e7
RS
64and \"-de\" when dehexlifying a buffer."
65 :type 'string
66 :group 'hexl)
a2535589 67
00ed33e7 68(defcustom hexl-iso ""
a2535589 69 "If your emacs can handle ISO characters, this should be set to
00ed33e7
RS
70\"-iso\" otherwise it should be \"\"."
71 :type 'string
72 :group 'hexl)
a2535589 73
00ed33e7
RS
74(defcustom hexl-options (format "-hex %s" hexl-iso)
75 "Options to hexl-program that suit your needs."
76 :type 'string
77 :group 'hexl)
a2535589 78
00ed33e7 79(defcustom hexlify-command
7e3a7716
AI
80 (format "%s %s"
81 (shell-quote-argument
82 (expand-file-name hexl-program exec-directory))
83 hexl-options)
00ed33e7
RS
84 "The command to use to hexlify a buffer."
85 :type 'string
86 :group 'hexl)
a2535589 87
00ed33e7 88(defcustom dehexlify-command
7e3a7716
AI
89 (format "%s -de %s"
90 (shell-quote-argument
91 (expand-file-name hexl-program exec-directory))
92 hexl-options)
00ed33e7
RS
93 "The command to use to unhexlify a buffer."
94 :type 'string
95 :group 'hexl)
a2535589 96
db6c5b92
SE
97(defcustom hexl-follow-ascii t
98 "If non-nil then highlight the ASCII character corresponding to point."
99 :type 'boolean
cd32a7ba
DN
100 :group 'hexl
101 :version "20.3")
db6c5b92 102
a2535589
JA
103(defvar hexl-max-address 0
104 "Maximum offset into hexl buffer.")
105
106(defvar hexl-mode-map nil)
107
f39c6650
RS
108(defvar hexl-mode-old-local-map)
109(defvar hexl-mode-old-mode-name)
110(defvar hexl-mode-old-major-mode)
0e4889b2
RS
111(defvar hexl-mode-old-write-contents-hooks)
112(defvar hexl-mode-old-require-final-newline)
113(defvar hexl-mode-old-syntax-table)
f39c6650 114
db6c5b92
SE
115(defvar hexl-ascii-overlay nil
116 "Overlay used to highlight ASCII element corresponding to current point.")
117(make-variable-buffer-local 'hexl-ascii-overlay)
118
a2535589
JA
119;; routines
120
2d902813
RS
121(put 'hexl-mode 'mode-class 'special)
122
31c75fa7 123;;;###autoload
a2535589 124(defun hexl-mode (&optional arg)
330bd7c3
PR
125 "\\<hexl-mode-map>A mode for editing binary files in hex dump format.
126This is not an ordinary major mode; it alters some aspects
127if the current mode's behavior, but not all; also, you can exit
128Hexl mode and return to the previous mode using `hexl-mode-exit'.
a2535589
JA
129
130This function automatically converts a buffer into the hexl format
131using the function `hexlify-buffer'.
132
8a1281b5 133Each line in the buffer has an \"address\" (displayed in hexadecimal)
a2535589
JA
134representing the offset into the file that the characters on this line
135are at and 16 characters from the file (displayed as hexadecimal
136values grouped every 16 bits) and as their ASCII values.
137
138If any of the characters (displayed as ASCII characters) are
139unprintable (control or meta characters) they will be replaced as
140periods.
141
8a1281b5
RS
142If `hexl-mode' is invoked with an argument the buffer is assumed to be
143in hexl format.
a2535589
JA
144
145A sample format:
146
147 HEX ADDR: 0001 0203 0405 0607 0809 0a0b 0c0d 0e0f ASCII-TEXT
148 -------- ---- ---- ---- ---- ---- ---- ---- ---- ----------------
149 00000000: 5468 6973 2069 7320 6865 786c 2d6d 6f64 This is hexl-mod
150 00000010: 652e 2020 4561 6368 206c 696e 6520 7265 e. Each line re
151 00000020: 7072 6573 656e 7473 2031 3620 6279 7465 presents 16 byte
152 00000030: 7320 6173 2068 6578 6164 6563 696d 616c s as hexadecimal
153 00000040: 2041 5343 4949 0a61 6e64 2070 7269 6e74 ASCII.and print
154 00000050: 6162 6c65 2041 5343 4949 2063 6861 7261 able ASCII chara
155 00000060: 6374 6572 732e 2020 416e 7920 636f 6e74 cters. Any cont
156 00000070: 726f 6c20 6f72 206e 6f6e 2d41 5343 4949 rol or non-ASCII
157 00000080: 2063 6861 7261 6374 6572 730a 6172 6520 characters.are
158 00000090: 6469 7370 6c61 7965 6420 6173 2070 6572 displayed as per
159 000000a0: 696f 6473 2069 6e20 7468 6520 7072 696e iods in the prin
160 000000b0: 7461 626c 6520 6368 6172 6163 7465 7220 table character
161 000000c0: 7265 6769 6f6e 2e0a region..
162
163Movement is as simple as movement in a normal emacs text buffer. Most
164cursor movement bindings are the same (ie. Use \\[hexl-backward-char], \\[hexl-forward-char], \\[hexl-next-line], and \\[hexl-previous-line]
165to move the cursor left, right, down, and up).
166
167Advanced cursor movement commands (ala \\[hexl-beginning-of-line], \\[hexl-end-of-line], \\[hexl-beginning-of-buffer], and \\[hexl-end-of-buffer]) are
168also supported.
169
170There are several ways to change text in hexl mode:
171
172ASCII characters (character between space (0x20) and tilde (0x7E)) are
173bound to self-insert so you can simply type the character and it will
174insert itself (actually overstrike) into the buffer.
175
176\\[hexl-quoted-insert] followed by another keystroke allows you to insert the key even if
177it isn't bound to self-insert. An octal number can be supplied in place
178of another key to insert the octal number's ASCII representation.
179
180\\[hexl-insert-hex-char] will insert a given hexadecimal value (if it is between 0 and 0xFF)
181into the buffer at the current point.
182
183\\[hexl-insert-octal-char] will insert a given octal value (if it is between 0 and 0377)
184into the buffer at the current point.
185
186\\[hexl-insert-decimal-char] will insert a given decimal value (if it is between 0 and 255)
187into the buffer at the current point.
188
a2535589
JA
189\\[hexl-mode-exit] will exit hexl-mode.
190
31c75fa7
RS
191Note: saving the file with any of the usual Emacs commands
192will actually convert it back to binary format while saving.
a2535589 193
330bd7c3 194You can use \\[hexl-find-file] to visit a file in Hexl mode.
a2535589
JA
195
196\\[describe-bindings] for advanced commands."
197 (interactive "p")
330bd7c3 198 (unless (eq major-mode 'hexl-mode)
753c1309
RS
199 (let ((modified (buffer-modified-p))
200 (inhibit-read-only t)
201 (original-point (1- (point)))
202 max-address)
203 (and (eobp) (not (bobp))
204 (setq original-point (1- original-point)))
205 (if (not (or (eq arg 1) (not arg)))
206 ;; if no argument then we guess at hexl-max-address
207 (setq max-address (+ (* (/ (1- (buffer-size)) 68) 16) 15))
208 (setq max-address (1- (buffer-size)))
7851eb98
EZ
209 ;; If the buffer's EOL type is -dos, we need to account for
210 ;; extra CR characters added when hexlify-buffer writes the
211 ;; buffer to a file.
212 (when (eq (coding-system-eol-type buffer-file-coding-system) 1)
213 (setq max-address (+ (count-lines (point-min) (point-max))
214 max-address))
215 ;; But if there's no newline at the last line, we are off by
216 ;; one; adjust.
217 (or (eq (char-before (point-max)) ?\n)
218 (setq max-address (1- max-address)))
219 (setq original-point (+ (count-lines (point-min) (point))
220 original-point))
221 (or (bolp) (setq original-point (1- original-point))))
753c1309
RS
222 (hexlify-buffer)
223 (set-buffer-modified-p modified))
224 (make-local-variable 'hexl-max-address)
225 (setq hexl-max-address max-address)
226 (hexl-goto-address original-point))
227
0e4889b2
RS
228 ;; We do not turn off the old major mode; instead we just
229 ;; override most of it. That way, we can restore it perfectly.
a2535589
JA
230 (make-local-variable 'hexl-mode-old-local-map)
231 (setq hexl-mode-old-local-map (current-local-map))
232 (use-local-map hexl-mode-map)
233
234 (make-local-variable 'hexl-mode-old-mode-name)
235 (setq hexl-mode-old-mode-name mode-name)
236 (setq mode-name "Hexl")
237
238 (make-local-variable 'hexl-mode-old-major-mode)
239 (setq hexl-mode-old-major-mode major-mode)
240 (setq major-mode 'hexl-mode)
241
0e4889b2
RS
242 (make-local-variable 'hexl-mode-old-syntax-table)
243 (setq hexl-mode-old-syntax-table (syntax-table))
244 (set-syntax-table (standard-syntax-table))
245
246 (make-local-variable 'hexl-mode-old-write-contents-hooks)
247 (setq hexl-mode-old-write-contents-hooks write-contents-hooks)
31c75fa7 248 (make-local-variable 'write-contents-hooks)
c6fcafde 249 (add-hook 'write-contents-hooks 'hexl-save-buffer)
31c75fa7 250
0e4889b2
RS
251 (make-local-variable 'hexl-mode-old-require-final-newline)
252 (setq hexl-mode-old-require-final-newline require-final-newline)
253 (make-local-variable 'require-final-newline)
254 (setq require-final-newline nil)
255
256 ;; Add hooks to rehexlify or dehexlify on various events.
c3de2bf0
RS
257 (make-local-hook 'after-revert-hook)
258 (add-hook 'after-revert-hook 'hexl-after-revert-hook nil t)
259
0e4889b2 260 (make-local-hook 'change-major-mode-hook)
db6c5b92
SE
261 (add-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer nil t)
262
263 (if hexl-follow-ascii (hexl-follow-ascii 1)))
7bfff21e 264 (run-hooks 'hexl-mode-hook))
a2535589 265
c3de2bf0 266(defun hexl-after-revert-hook ()
059c2e18 267 (setq hexl-max-address (1- (buffer-size)))
c3de2bf0
RS
268 (hexlify-buffer)
269 (set-buffer-modified-p nil))
270
ac2e902d
JB
271(defvar hexl-in-save-buffer nil)
272
a2535589
JA
273(defun hexl-save-buffer ()
274 "Save a hexl format buffer as binary in visited file if modified."
275 (interactive)
ac2e902d
JB
276 (if hexl-in-save-buffer nil
277 (set-buffer-modified-p (if (buffer-modified-p)
278 (save-excursion
279 (let ((buf (generate-new-buffer " hexl"))
280 (name (buffer-name))
281 (file-name (buffer-file-name))
282 (start (point-min))
283 (end (point-max))
284 modified)
285 (set-buffer buf)
286 (insert-buffer-substring name start end)
287 (set-buffer name)
288 (dehexlify-buffer)
289 ;; Prevent infinite recursion.
338992a5 290 (let ((hexl-in-save-buffer t))
ac2e902d
JB
291 (save-buffer))
292 (setq modified (buffer-modified-p))
293 (delete-region (point-min) (point-max))
294 (insert-buffer-substring buf start end)
295 (kill-buffer buf)
296 modified))
297 (message "(No changes need to be saved)")
298 nil))
299 ;; Return t to indicate we have saved t
300 t))
a2535589 301
31c75fa7 302;;;###autoload
a2535589
JA
303(defun hexl-find-file (filename)
304 "Edit file FILENAME in hexl-mode.
a2535589
JA
305Switch to a buffer visiting file FILENAME, creating one in none exists."
306 (interactive "fFilename: ")
338992a5 307 (find-file-literally filename)
a2535589
JA
308 (if (not (eq major-mode 'hexl-mode))
309 (hexl-mode)))
310
311(defun hexl-mode-exit (&optional arg)
31c75fa7 312 "Exit Hexl mode, returning to previous mode.
a2535589
JA
313With arg, don't unhexlify buffer."
314 (interactive "p")
315 (if (or (eq arg 1) (not arg))
316 (let ((modified (buffer-modified-p))
900014dd 317 (inhibit-read-only t)
a2535589 318 (original-point (1+ (hexl-current-address))))
a2535589 319 (dehexlify-buffer)
95d87237 320 (remove-hook 'write-contents-hooks 'hexl-save-buffer)
a2535589 321 (set-buffer-modified-p modified)
7851eb98
EZ
322 (goto-char original-point)
323 ;; Maybe adjust point for the removed CR characters.
324 (when (eq (coding-system-eol-type buffer-file-coding-system) 1)
325 (setq original-point (- original-point
326 (count-lines (point-min) (point))))
327 (or (bobp) (setq original-point (1+ original-point))))
a2535589 328 (goto-char original-point)))
0e4889b2
RS
329
330 (remove-hook 'after-revert-hook 'hexl-after-revert-hook t)
331 (remove-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer t)
8e7df2e6
SE
332 (remove-hook 'post-command-hook 'hexl-follow-ascii-find t)
333 (setq hexl-ascii-overlay nil)
0e4889b2
RS
334
335 (setq write-contents-hooks hexl-mode-old-write-contents-hooks)
336 (setq require-final-newline hexl-mode-old-require-final-newline)
a2535589
JA
337 (setq mode-name hexl-mode-old-mode-name)
338 (use-local-map hexl-mode-old-local-map)
0e4889b2 339 (set-syntax-table hexl-mode-old-syntax-table)
a2535589 340 (setq major-mode hexl-mode-old-major-mode)
8eeac2ce
RS
341 (force-mode-line-update))
342
343(defun hexl-maybe-dehexlify-buffer ()
344 "Convert a hexl format buffer to binary.
345Ask the user for confirmation."
346 (if (y-or-n-p "Convert contents back to binary format? ")
347 (let ((modified (buffer-modified-p))
348 (inhibit-read-only t)
349 (original-point (1+ (hexl-current-address))))
350 (dehexlify-buffer)
95d87237 351 (remove-hook 'write-contents-hooks 'hexl-save-buffer)
8eeac2ce
RS
352 (set-buffer-modified-p modified)
353 (goto-char original-point))))
a2535589 354
6bbb008e 355(defun hexl-current-address (&optional validate)
a2535589
JA
356 "Return current hexl-address."
357 (interactive)
d565f6aa 358 (let ((current-column (- (% (point) 68) 11))
a2535589 359 (hexl-address 0))
6bbb008e
RS
360 (if (< current-column 0)
361 (if validate
362 (error "Point is not on a character in the file")
363 (setq current-column 0)))
364 (setq hexl-address
365 (+ (* (/ (point) 68) 16)
366 (if (>= current-column 41)
367 (- current-column 41)
368 (/ (- current-column (/ current-column 5)) 2))))
48f56596
GM
369 (when (interactive-p)
370 (message "Current address is %d" hexl-address))
a2535589
JA
371 hexl-address))
372
373(defun hexl-address-to-marker (address)
059c2e18 374 "Return buffer position for ADDRESS."
a2535589
JA
375 (interactive "nAddress: ")
376 (+ (* (/ address 16) 68) 11 (/ (* (% address 16) 5) 2)))
377
378(defun hexl-goto-address (address)
379 "Goto hexl-mode (decimal) address ADDRESS.
a2535589
JA
380Signal error if ADDRESS out of range."
381 (interactive "nAddress: ")
382 (if (or (< address 0) (> address hexl-max-address))
19e31f7c 383 (error "Out of hexl region"))
a2535589
JA
384 (goto-char (hexl-address-to-marker address)))
385
386(defun hexl-goto-hex-address (hex-address)
4c8c7ae9 387 "Go to hexl-mode address (hex string) HEX-ADDRESS.
a2535589
JA
388Signal error if HEX-ADDRESS is out of range."
389 (interactive "sHex Address: ")
390 (hexl-goto-address (hexl-hex-string-to-integer hex-address)))
391
392(defun hexl-hex-string-to-integer (hex-string)
393 "Return decimal integer for HEX-STRING."
394 (interactive "sHex number: ")
395 (let ((hex-num 0))
396 (while (not (equal hex-string ""))
397 (setq hex-num (+ (* hex-num 16)
398 (hexl-hex-char-to-integer (string-to-char hex-string))))
399 (setq hex-string (substring hex-string 1)))
400 hex-num))
401
402(defun hexl-octal-string-to-integer (octal-string)
403 "Return decimal integer for OCTAL-STRING."
404 (interactive "sOctal number: ")
405 (let ((oct-num 0))
406 (while (not (equal octal-string ""))
407 (setq oct-num (+ (* oct-num 8)
408 (hexl-oct-char-to-integer
409 (string-to-char octal-string))))
410 (setq octal-string (substring octal-string 1)))
411 oct-num))
412
413;; move point functions
414
415(defun hexl-backward-char (arg)
416 "Move to left ARG bytes (right if ARG negative) in hexl-mode."
417 (interactive "p")
418 (hexl-goto-address (- (hexl-current-address) arg)))
419
420(defun hexl-forward-char (arg)
421 "Move right ARG bytes (left if ARG negative) in hexl-mode."
422 (interactive "p")
423 (hexl-goto-address (+ (hexl-current-address) arg)))
424
425(defun hexl-backward-short (arg)
426 "Move to left ARG shorts (right if ARG negative) in hexl-mode."
427 (interactive "p")
428 (hexl-goto-address (let ((address (hexl-current-address)))
429 (if (< arg 0)
430 (progn
431 (setq arg (- arg))
432 (while (> arg 0)
433 (if (not (equal address (logior address 3)))
434 (if (> address hexl-max-address)
435 (progn
436 (message "End of buffer.")
437 (setq address hexl-max-address))
438 (setq address (logior address 3)))
439 (if (> address hexl-max-address)
440 (progn
441 (message "End of buffer.")
442 (setq address hexl-max-address))
443 (setq address (+ address 4))))
444 (setq arg (1- arg)))
445 (if (> address hexl-max-address)
446 (progn
447 (message "End of buffer.")
448 (setq address hexl-max-address))
449 (setq address (logior address 3))))
450 (while (> arg 0)
451 (if (not (equal address (logand address -4)))
452 (setq address (logand address -4))
453 (if (not (equal address 0))
454 (setq address (- address 4))
455 (message "Beginning of buffer.")))
456 (setq arg (1- arg))))
457 address)))
458
459(defun hexl-forward-short (arg)
460 "Move right ARG shorts (left if ARG negative) in hexl-mode."
461 (interactive "p")
462 (hexl-backward-short (- arg)))
463
464(defun hexl-backward-word (arg)
465 "Move to left ARG words (right if ARG negative) in hexl-mode."
466 (interactive "p")
467 (hexl-goto-address (let ((address (hexl-current-address)))
468 (if (< arg 0)
469 (progn
470 (setq arg (- arg))
471 (while (> arg 0)
472 (if (not (equal address (logior address 7)))
473 (if (> address hexl-max-address)
474 (progn
475 (message "End of buffer.")
476 (setq address hexl-max-address))
477 (setq address (logior address 7)))
478 (if (> address hexl-max-address)
479 (progn
480 (message "End of buffer.")
481 (setq address hexl-max-address))
482 (setq address (+ address 8))))
483 (setq arg (1- arg)))
484 (if (> address hexl-max-address)
485 (progn
486 (message "End of buffer.")
487 (setq address hexl-max-address))
488 (setq address (logior address 7))))
489 (while (> arg 0)
490 (if (not (equal address (logand address -8)))
491 (setq address (logand address -8))
492 (if (not (equal address 0))
493 (setq address (- address 8))
494 (message "Beginning of buffer.")))
495 (setq arg (1- arg))))
496 address)))
497
498(defun hexl-forward-word (arg)
499 "Move right ARG words (left if ARG negative) in hexl-mode."
500 (interactive "p")
501 (hexl-backward-word (- arg)))
502
503(defun hexl-previous-line (arg)
4c8c7ae9
JB
504 "Move vertically up ARG lines [16 bytes] (down if ARG negative) in hexl-mode.
505If there is byte at the target address move to the last byte in that line."
a2535589
JA
506 (interactive "p")
507 (hexl-next-line (- arg)))
508
509(defun hexl-next-line (arg)
4c8c7ae9
JB
510 "Move vertically down ARG lines [16 bytes] (up if ARG negative) in hexl-mode.
511If there is no byte at the target address move to the last byte in that line."
a2535589 512 (interactive "p")
e8a57935 513 (hexl-goto-address (let ((address (+ (hexl-current-address) (* arg 16))))
a2535589
JA
514 (if (and (< arg 0) (< address 0))
515 (progn (message "Out of hexl region.")
516 (setq address
517 (% (hexl-current-address) 16)))
518 (if (and (> address hexl-max-address)
519 (< (% hexl-max-address 16) (% address 16)))
520 (setq address hexl-max-address)
521 (if (> address hexl-max-address)
522 (progn (message "Out of hexl region.")
523 (setq
524 address
525 (+ (logand hexl-max-address -16)
526 (% (hexl-current-address) 16)))))))
527 address)))
528
529(defun hexl-beginning-of-buffer (arg)
4c8c7ae9
JB
530 "Move to the beginning of the hexl buffer.
531Leaves `hexl-mark' at previous position.
532With prefix arg N, puts point N bytes of the way from the true beginning."
a2535589
JA
533 (interactive "p")
534 (push-mark (point))
535 (hexl-goto-address (+ 0 (1- arg))))
536
537(defun hexl-end-of-buffer (arg)
4c8c7ae9 538 "Go to `hexl-max-address' minus ARG."
a2535589
JA
539 (interactive "p")
540 (push-mark (point))
541 (hexl-goto-address (- hexl-max-address (1- arg))))
542
543(defun hexl-beginning-of-line ()
544 "Goto beginning of line in hexl mode."
545 (interactive)
546 (goto-char (+ (* (/ (point) 68) 68) 11)))
547
548(defun hexl-end-of-line ()
549 "Goto end of line in hexl mode."
550 (interactive)
551 (hexl-goto-address (let ((address (logior (hexl-current-address) 15)))
552 (if (> address hexl-max-address)
553 (setq address hexl-max-address))
554 address)))
555
556(defun hexl-scroll-down (arg)
557 "Scroll hexl buffer window upward ARG lines; or near full window if no ARG."
558 (interactive "P")
559 (if (null arg)
560 (setq arg (1- (window-height)))
561 (setq arg (prefix-numeric-value arg)))
562 (hexl-scroll-up (- arg)))
563
564(defun hexl-scroll-up (arg)
d565f6aa
EZ
565 "Scroll hexl buffer window upward ARG lines; or near full window if no ARG.
566If there's no byte at the target address, move to the first or last line."
a2535589
JA
567 (interactive "P")
568 (if (null arg)
569 (setq arg (1- (window-height)))
570 (setq arg (prefix-numeric-value arg)))
d565f6aa
EZ
571 (let* ((movement (* arg 16))
572 (address (hexl-current-address))
573 (dest (+ address movement)))
574 (cond
575 ;; If possible, try to stay at the same offset from the beginning
576 ;; of the 16-byte group, even if we move to the first or last
577 ;; group.
578 ((and (> dest hexl-max-address)
579 (>= (% hexl-max-address 16) (% address 16)))
580 (setq dest (+ (logand hexl-max-address -16) (% address 16))))
581 ((> dest hexl-max-address)
582 (setq dest hexl-max-address))
583 ((< dest 0)
584 (setq dest (% address 16))))
585 (if (/= dest (+ address movement))
586 (message "Out of hexl region."))
587 (hexl-goto-address dest)
588 (recenter 0)))
a2535589
JA
589
590(defun hexl-beginning-of-1k-page ()
65e5f4bc 591 "Go to beginning of 1k boundary."
a2535589
JA
592 (interactive)
593 (hexl-goto-address (logand (hexl-current-address) -1024)))
594
595(defun hexl-end-of-1k-page ()
65e5f4bc 596 "Go to end of 1k boundary."
a2535589
JA
597 (interactive)
598 (hexl-goto-address (let ((address (logior (hexl-current-address) 1023)))
599 (if (> address hexl-max-address)
600 (setq address hexl-max-address))
601 address)))
602
603(defun hexl-beginning-of-512b-page ()
65e5f4bc 604 "Go to beginning of 512 byte boundary."
a2535589
JA
605 (interactive)
606 (hexl-goto-address (logand (hexl-current-address) -512)))
607
608(defun hexl-end-of-512b-page ()
65e5f4bc 609 "Go to end of 512 byte boundary."
a2535589
JA
610 (interactive)
611 (hexl-goto-address (let ((address (logior (hexl-current-address) 511)))
612 (if (> address hexl-max-address)
613 (setq address hexl-max-address))
614 address)))
615
616(defun hexl-quoted-insert (arg)
617 "Read next input character and insert it.
02aec07b
EZ
618Useful for inserting control characters and non-ASCII characters given their
619numerical code.
620You may also type octal digits, to insert a character with that code."
a2535589 621 (interactive "p")
02aec07b 622 (hexl-insert-multibyte-char (read-quoted-char) arg))
a2535589
JA
623
624;00000000: 0011 2233 4455 6677 8899 aabb ccdd eeff 0123456789ABCDEF
625
f4e3d4eb 626;;;###autoload
a2535589 627(defun hexlify-buffer ()
aa3757b8
RS
628 "Convert a binary buffer to hexl format.
629This discards the buffer's undo information."
a2535589 630 (interactive)
aa3757b8
RS
631 (and buffer-undo-list
632 (or (y-or-n-p "Converting to hexl format discards undo info; ok? ")
633 (error "Aborted")))
634 (setq buffer-undo-list nil)
a749e5e5
EZ
635 ;; Don't decode text in the ASCII part of `hexl' program output.
636 (let ((coding-system-for-read 'raw-text)
0716afa2 637 (coding-system-for-write buffer-file-coding-system)
aa3757b8 638 (buffer-undo-list t))
059c2e18
PR
639 (shell-command-on-region (point-min) (point-max) hexlify-command t)
640 (if (> (point) (hexl-address-to-marker hexl-max-address))
641 (hexl-goto-address hexl-max-address))))
a2535589
JA
642
643(defun dehexlify-buffer ()
aa3757b8
RS
644 "Convert a hexl format buffer to binary.
645This discards the buffer's undo information."
a2535589 646 (interactive)
aa3757b8
RS
647 (and buffer-undo-list
648 (or (y-or-n-p "Converting from hexl format discards undo info; ok? ")
649 (error "Aborted")))
650 (setq buffer-undo-list nil)
a749e5e5 651 (let ((coding-system-for-write 'raw-text)
0716afa2 652 (coding-system-for-read buffer-file-coding-system)
aa3757b8 653 (buffer-undo-list t))
10b501e3 654 (shell-command-on-region (point-min) (point-max) dehexlify-command t)))
a2535589
JA
655
656(defun hexl-char-after-point ()
657 "Return char for ASCII hex digits at point."
686fc9ab
RS
658 (hexl-htoi (char-after (point))
659 (char-after (1+ (point)))))
a2535589
JA
660
661(defun hexl-htoi (lh rh)
662 "Hex (char) LH (char) RH to integer."
663 (+ (* (hexl-hex-char-to-integer lh) 16)
664 (hexl-hex-char-to-integer rh)))
665
666(defun hexl-hex-char-to-integer (character)
667 "Take a char and return its value as if it was a hex digit."
668 (if (and (>= character ?0) (<= character ?9))
669 (- character ?0)
670 (let ((ch (logior character 32)))
671 (if (and (>= ch ?a) (<= ch ?f))
672 (- ch (- ?a 10))
19e31f7c 673 (error "Invalid hex digit `%c'" ch)))))
a2535589
JA
674
675(defun hexl-oct-char-to-integer (character)
676 "Take a char and return its value as if it was a octal digit."
677 (if (and (>= character ?0) (<= character ?7))
678 (- character ?0)
19e31f7c 679 (error "Invalid octal digit `%c'" character)))
a2535589
JA
680
681(defun hexl-printable-character (ch)
682 "Return a displayable string for character CH."
683 (format "%c" (if hexl-iso
684 (if (or (< ch 32) (and (>= ch 127) (< ch 160)))
685 46
686 ch)
687 (if (or (< ch 32) (>= ch 127))
688 46
689 ch))))
690
02aec07b
EZ
691(defun hexl-insert-multibyte-char (ch num)
692 "Insert a possibly multibyte character CH NUM times.
693
694Non-ASCII characters are first encoded with `buffer-file-coding-system',
695and their encoded form is inserted byte by byte."
696 (let ((charset (char-charset ch))
697 (coding (if (or (null buffer-file-coding-system)
698 ;; coding-system-type equals t means undecided.
699 (eq (coding-system-type buffer-file-coding-system) t))
700 default-buffer-file-coding-system
701 buffer-file-coding-system)))
702 (cond ((and (> ch 0) (< ch 256))
703 (hexl-insert-char ch num))
704 ((eq charset 'unknown)
705 (error
165b4283 706 "0x%x -- invalid character code; use \\[hexl-insert-hex-string]"
02aec07b
EZ
707 ch))
708 (t
709 (let ((encoded (encode-coding-char ch coding))
710 (internal (string-as-unibyte (char-to-string ch)))
711 internal-hex)
712 ;; If encode-coding-char returns nil, it means our character
713 ;; cannot be safely encoded with buffer-file-coding-system.
714 ;; In that case, we offer to insert the internal representation
715 ;; of that character, byte by byte.
716 (when (null encoded)
717 (setq internal-hex
718 (mapconcat (function (lambda (c) (format "%x" c)))
719 internal " "))
720 (if (yes-or-no-p
721 (format
722 "Insert char 0x%x's internal representation \"%s\"? "
723 ch internal-hex))
724 (setq encoded internal)
725 (error
165b4283 726 "Can't encode `0x%x' with this buffer's coding system; try \\[hexl-insert-hex-string]"
02aec07b
EZ
727 ch)))
728 (while (> num 0)
729 (mapc
730 (function (lambda (c) (hexl-insert-char c 1))) encoded)
731 (setq num (1- num))))))))
732
a2535589 733(defun hexl-self-insert-command (arg)
02aec07b
EZ
734 "Insert this character.
735Interactively, with a numeric argument, insert this character that many times.
736
737Non-ASCII characters are first encoded with `buffer-file-coding-system',
738and their encoded form is inserted byte by byte."
a2535589 739 (interactive "p")
02aec07b 740 (hexl-insert-multibyte-char last-command-char arg))
a2535589
JA
741
742(defun hexl-insert-char (ch num)
02aec07b
EZ
743 "Insert the character CH NUM times in a hexl buffer.
744
745CH must be a unibyte character whose value is between 0 and 255."
746 (if (or (< ch 0) (> ch 255))
165b4283 747 (error "Invalid character 0x%x -- must be in the range [0..255]"))
6bbb008e 748 (let ((address (hexl-current-address t)))
a2535589 749 (while (> num 0)
6bbb008e
RS
750 (let ((hex-position
751 (+ (* (/ address 16) 68)
752 11
753 (* 2 (% address 16))
754 (/ (% address 16) 2)))
755 (ascii-position
756 (+ (* (/ address 16) 68) 52 (% address 16)))
757 at-ascii-position)
758 (if (= (point) ascii-position)
759 (setq at-ascii-position t))
760 (goto-char hex-position)
761 (delete-char 2)
762 (insert (format "%02x" ch))
763 (goto-char ascii-position)
764 (delete-char 1)
765 (insert (hexl-printable-character ch))
766 (or (eq address hexl-max-address)
767 (setq address (1+ address)))
768 (hexl-goto-address address)
769 (if at-ascii-position
770 (progn
771 (beginning-of-line)
772 (forward-char 51)
773 (forward-char (% address 16)))))
a2535589
JA
774 (setq num (1- num)))))
775
776;; hex conversion
777
778(defun hexl-insert-hex-char (arg)
02aec07b 779 "Insert a character given by its hexadecimal code ARG times at point."
a2535589
JA
780 (interactive "p")
781 (let ((num (hexl-hex-string-to-integer (read-string "Hex number: "))))
02aec07b 782 (if (< num 0)
19e31f7c 783 (error "Hex number out of range")
02aec07b 784 (hexl-insert-multibyte-char num arg))))
a2535589 785
9f6bff44
GM
786(defun hexl-insert-hex-string (str arg)
787 "Insert hexadecimal string STR at point ARG times.
788Embedded whitespace, dashes, and periods in the string are ignored."
789 (interactive "sHex string: \np")
790 (setq str (replace-regexp-in-string "[- \t.]" "" str))
791 (let ((chars '()))
792 (let ((len (length str))
793 (idx 0))
794 (if (eq (logand len 1) 1)
795 (let ((num (hexl-hex-string-to-integer (substring str 0 1))))
796 (setq chars (cons num chars))
797 (setq idx 1)))
798 (while (< idx len)
799 (let* ((nidx (+ idx 2))
800 (num (hexl-hex-string-to-integer (substring str idx nidx))))
801 (setq chars (cons num chars))
802 (setq idx nidx))))
803 (setq chars (nreverse chars))
804 (while (> arg 0)
805 (let ((chars chars))
806 (while chars
807 (hexl-insert-char (car chars) 1)
808 (setq chars (cdr chars))))
809 (setq arg (- arg 1)))))
810
a2535589 811(defun hexl-insert-decimal-char (arg)
02aec07b 812 "Insert a character given by its decimal code ARG times at point."
a2535589
JA
813 (interactive "p")
814 (let ((num (string-to-int (read-string "Decimal Number: "))))
02aec07b 815 (if (< num 0)
19e31f7c 816 (error "Decimal number out of range")
02aec07b 817 (hexl-insert-multibyte-char num arg))))
a2535589
JA
818
819(defun hexl-insert-octal-char (arg)
02aec07b 820 "Insert a character given by its octal code ARG times at point."
a2535589
JA
821 (interactive "p")
822 (let ((num (hexl-octal-string-to-integer (read-string "Octal Number: "))))
02aec07b 823 (if (< num 0)
19e31f7c 824 (error "Decimal number out of range")
02aec07b 825 (hexl-insert-multibyte-char num arg))))
a2535589 826
db6c5b92
SE
827(defun hexl-follow-ascii (&optional arg)
828 "Toggle following ASCII in Hexl buffers.
829With prefix ARG, turn on following if and only if ARG is positive.
830When following is enabled, the ASCII character corresponding to the
831element under the point is highlighted.
832Customize the variable `hexl-follow-ascii' to disable this feature."
833 (interactive "P")
834 (let ((on-p (if arg
835 (> (prefix-numeric-value arg) 0)
836 (not hexl-ascii-overlay))))
837
838 (make-local-hook 'post-command-hook)
839
840 (if on-p
841 ;; turn it on
842 (if (not hexl-ascii-overlay)
843 (progn
844 (setq hexl-ascii-overlay (make-overlay 1 1)
845 hexl-follow-ascii t)
846 (overlay-put hexl-ascii-overlay 'face 'highlight)
847 (add-hook 'post-command-hook 'hexl-follow-ascii-find nil t)))
848 ;; turn it off
849 (if hexl-ascii-overlay
850 (progn
851 (delete-overlay hexl-ascii-overlay)
852 (setq hexl-ascii-overlay nil
853 hexl-follow-ascii nil)
854 (remove-hook 'post-command-hook 'hexl-follow-ascii-find t)
855 )))))
856
857(defun hexl-follow-ascii-find ()
858 "Find and highlight the ASCII element corresponding to current point."
d565f6aa 859 (let ((pos (+ 51
db6c5b92
SE
860 (- (point) (current-column))
861 (mod (hexl-current-address) 16))))
862 (move-overlay hexl-ascii-overlay pos (1+ pos))
863 ))
864
a2535589
JA
865;; startup stuff.
866
867(if hexl-mode-map
868 nil
4b7dd7e2 869 (setq hexl-mode-map (make-keymap))
02aec07b
EZ
870 ;; Make all self-inserting keys go through hexl-self-insert-command,
871 ;; because we need to convert them to unibyte characters before
872 ;; inserting them into the buffer.
873 (substitute-key-definition 'self-insert-command 'hexl-self-insert-command
4b7dd7e2 874 hexl-mode-map (current-global-map))
ae2d451b
RS
875
876 (define-key hexl-mode-map [left] 'hexl-backward-char)
877 (define-key hexl-mode-map [right] 'hexl-forward-char)
878 (define-key hexl-mode-map [up] 'hexl-previous-line)
879 (define-key hexl-mode-map [down] 'hexl-next-line)
880 (define-key hexl-mode-map [M-left] 'hexl-backward-short)
881 (define-key hexl-mode-map [M-right] 'hexl-forward-short)
882 (define-key hexl-mode-map [next] 'hexl-scroll-up)
883 (define-key hexl-mode-map [prior] 'hexl-scroll-down)
d565f6aa
EZ
884 (define-key hexl-mode-map [home] 'hexl-beginning-of-line)
885 (define-key hexl-mode-map [end] 'hexl-end-of-line)
886 (define-key hexl-mode-map [C-home] 'hexl-beginning-of-buffer)
887 (define-key hexl-mode-map [C-end] 'hexl-end-of-buffer)
ae2d451b
RS
888 (define-key hexl-mode-map [deletechar] 'undefined)
889 (define-key hexl-mode-map [deleteline] 'undefined)
890 (define-key hexl-mode-map [insertline] 'undefined)
891 (define-key hexl-mode-map [S-delete] 'undefined)
892 (define-key hexl-mode-map "\177" 'undefined)
893
894 (define-key hexl-mode-map "\C-a" 'hexl-beginning-of-line)
895 (define-key hexl-mode-map "\C-b" 'hexl-backward-char)
896 (define-key hexl-mode-map "\C-d" 'undefined)
897 (define-key hexl-mode-map "\C-e" 'hexl-end-of-line)
898 (define-key hexl-mode-map "\C-f" 'hexl-forward-char)
899
900 (if (not (eq (key-binding (char-to-string help-char)) 'help-command))
901 (define-key hexl-mode-map (char-to-string help-char) 'undefined))
902
ae2d451b 903 (define-key hexl-mode-map "\C-k" 'undefined)
ae2d451b
RS
904 (define-key hexl-mode-map "\C-n" 'hexl-next-line)
905 (define-key hexl-mode-map "\C-o" 'undefined)
906 (define-key hexl-mode-map "\C-p" 'hexl-previous-line)
907 (define-key hexl-mode-map "\C-q" 'hexl-quoted-insert)
908 (define-key hexl-mode-map "\C-t" 'undefined)
909 (define-key hexl-mode-map "\C-v" 'hexl-scroll-up)
910 (define-key hexl-mode-map "\C-w" 'undefined)
911 (define-key hexl-mode-map "\C-y" 'undefined)
912
02aec07b
EZ
913 (fset 'hexl-ESC-prefix (copy-keymap 'ESC-prefix))
914 (define-key hexl-mode-map "\e" 'hexl-ESC-prefix)
ae2d451b
RS
915 (define-key hexl-mode-map "\e\C-a" 'hexl-beginning-of-512b-page)
916 (define-key hexl-mode-map "\e\C-b" 'hexl-backward-short)
ae2d451b
RS
917 (define-key hexl-mode-map "\e\C-d" 'hexl-insert-decimal-char)
918 (define-key hexl-mode-map "\e\C-e" 'hexl-end-of-512b-page)
919 (define-key hexl-mode-map "\e\C-f" 'hexl-forward-short)
ae2d451b
RS
920 (define-key hexl-mode-map "\e\C-i" 'undefined)
921 (define-key hexl-mode-map "\e\C-j" 'undefined)
922 (define-key hexl-mode-map "\e\C-k" 'undefined)
ae2d451b 923 (define-key hexl-mode-map "\e\C-o" 'hexl-insert-octal-char)
ae2d451b 924 (define-key hexl-mode-map "\e\C-q" 'undefined)
ae2d451b 925 (define-key hexl-mode-map "\e\C-t" 'undefined)
ae2d451b 926 (define-key hexl-mode-map "\e\C-x" 'hexl-insert-hex-char)
ae2d451b
RS
927 (define-key hexl-mode-map "\eb" 'hexl-backward-word)
928 (define-key hexl-mode-map "\ec" 'undefined)
929 (define-key hexl-mode-map "\ed" 'undefined)
ae2d451b
RS
930 (define-key hexl-mode-map "\ef" 'hexl-forward-word)
931 (define-key hexl-mode-map "\eg" 'hexl-goto-hex-address)
ae2d451b
RS
932 (define-key hexl-mode-map "\ei" 'undefined)
933 (define-key hexl-mode-map "\ej" 'hexl-goto-address)
934 (define-key hexl-mode-map "\ek" 'undefined)
935 (define-key hexl-mode-map "\el" 'undefined)
ae2d451b 936 (define-key hexl-mode-map "\eq" 'undefined)
ae2d451b
RS
937 (define-key hexl-mode-map "\es" 'undefined)
938 (define-key hexl-mode-map "\et" 'undefined)
939 (define-key hexl-mode-map "\eu" 'undefined)
940 (define-key hexl-mode-map "\ev" 'hexl-scroll-down)
941 (define-key hexl-mode-map "\ey" 'undefined)
942 (define-key hexl-mode-map "\ez" 'undefined)
943 (define-key hexl-mode-map "\e<" 'hexl-beginning-of-buffer)
944 (define-key hexl-mode-map "\e>" 'hexl-end-of-buffer)
945
02aec07b
EZ
946 (fset 'hexl-C-c-prefix (copy-keymap mode-specific-map))
947 (define-key hexl-mode-map "\C-c" 'hexl-C-c-prefix)
ae2d451b
RS
948 (define-key hexl-mode-map "\C-c\C-c" 'hexl-mode-exit)
949
02aec07b
EZ
950 (fset 'hexl-C-x-prefix (copy-keymap 'Control-X-prefix))
951 (define-key hexl-mode-map "\C-x" 'hexl-C-x-prefix)
ae2d451b
RS
952 (define-key hexl-mode-map "\C-x[" 'hexl-beginning-of-1k-page)
953 (define-key hexl-mode-map "\C-x]" 'hexl-end-of-1k-page)
954 (define-key hexl-mode-map "\C-x\C-p" 'undefined)
955 (define-key hexl-mode-map "\C-x\C-s" 'hexl-save-buffer)
956 (define-key hexl-mode-map "\C-x\C-t" 'undefined))
a2535589 957
19e31f7c
RS
958(provide 'hexl)
959
1a06eabd 960;;; hexl.el ends here