(mm-charset-synonym-alist): Add windows-1252.
[bpt/emacs.git] / lisp / hexl.el
CommitLineData
a22f4c7d 1;;; hexl.el --- edit a file in a hex dump format using the hexl filter.
e5167999 2
0c4b86da 3;; Copyright (C) 1989, 1994, 1998 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)))
209 (hexlify-buffer)
210 (set-buffer-modified-p modified))
211 (make-local-variable 'hexl-max-address)
212 (setq hexl-max-address max-address)
213 (hexl-goto-address original-point))
214
0e4889b2
RS
215 ;; We do not turn off the old major mode; instead we just
216 ;; override most of it. That way, we can restore it perfectly.
a2535589
JA
217 (make-local-variable 'hexl-mode-old-local-map)
218 (setq hexl-mode-old-local-map (current-local-map))
219 (use-local-map hexl-mode-map)
220
221 (make-local-variable 'hexl-mode-old-mode-name)
222 (setq hexl-mode-old-mode-name mode-name)
223 (setq mode-name "Hexl")
224
225 (make-local-variable 'hexl-mode-old-major-mode)
226 (setq hexl-mode-old-major-mode major-mode)
227 (setq major-mode 'hexl-mode)
228
0e4889b2
RS
229 (make-local-variable 'hexl-mode-old-syntax-table)
230 (setq hexl-mode-old-syntax-table (syntax-table))
231 (set-syntax-table (standard-syntax-table))
232
233 (make-local-variable 'hexl-mode-old-write-contents-hooks)
234 (setq hexl-mode-old-write-contents-hooks write-contents-hooks)
31c75fa7 235 (make-local-variable 'write-contents-hooks)
c6fcafde 236 (add-hook 'write-contents-hooks 'hexl-save-buffer)
31c75fa7 237
0e4889b2
RS
238 (make-local-variable 'hexl-mode-old-require-final-newline)
239 (setq hexl-mode-old-require-final-newline require-final-newline)
240 (make-local-variable 'require-final-newline)
241 (setq require-final-newline nil)
242
243 ;; Add hooks to rehexlify or dehexlify on various events.
c3de2bf0
RS
244 (make-local-hook 'after-revert-hook)
245 (add-hook 'after-revert-hook 'hexl-after-revert-hook nil t)
246
0e4889b2 247 (make-local-hook 'change-major-mode-hook)
db6c5b92
SE
248 (add-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer nil t)
249
250 (if hexl-follow-ascii (hexl-follow-ascii 1)))
7bfff21e 251 (run-hooks 'hexl-mode-hook))
a2535589 252
c3de2bf0 253(defun hexl-after-revert-hook ()
059c2e18 254 (setq hexl-max-address (1- (buffer-size)))
c3de2bf0
RS
255 (hexlify-buffer)
256 (set-buffer-modified-p nil))
257
ac2e902d
JB
258(defvar hexl-in-save-buffer nil)
259
a2535589
JA
260(defun hexl-save-buffer ()
261 "Save a hexl format buffer as binary in visited file if modified."
262 (interactive)
ac2e902d
JB
263 (if hexl-in-save-buffer nil
264 (set-buffer-modified-p (if (buffer-modified-p)
265 (save-excursion
266 (let ((buf (generate-new-buffer " hexl"))
267 (name (buffer-name))
268 (file-name (buffer-file-name))
269 (start (point-min))
270 (end (point-max))
271 modified)
272 (set-buffer buf)
273 (insert-buffer-substring name start end)
274 (set-buffer name)
275 (dehexlify-buffer)
276 ;; Prevent infinite recursion.
338992a5 277 (let ((hexl-in-save-buffer t))
ac2e902d
JB
278 (save-buffer))
279 (setq modified (buffer-modified-p))
280 (delete-region (point-min) (point-max))
281 (insert-buffer-substring buf start end)
282 (kill-buffer buf)
283 modified))
284 (message "(No changes need to be saved)")
285 nil))
286 ;; Return t to indicate we have saved t
287 t))
a2535589 288
31c75fa7 289;;;###autoload
a2535589
JA
290(defun hexl-find-file (filename)
291 "Edit file FILENAME in hexl-mode.
a2535589
JA
292Switch to a buffer visiting file FILENAME, creating one in none exists."
293 (interactive "fFilename: ")
338992a5 294 (find-file-literally filename)
a2535589
JA
295 (if (not (eq major-mode 'hexl-mode))
296 (hexl-mode)))
297
298(defun hexl-mode-exit (&optional arg)
31c75fa7 299 "Exit Hexl mode, returning to previous mode.
a2535589
JA
300With arg, don't unhexlify buffer."
301 (interactive "p")
302 (if (or (eq arg 1) (not arg))
303 (let ((modified (buffer-modified-p))
900014dd 304 (inhibit-read-only t)
a2535589 305 (original-point (1+ (hexl-current-address))))
a2535589 306 (dehexlify-buffer)
95d87237 307 (remove-hook 'write-contents-hooks 'hexl-save-buffer)
a2535589 308 (set-buffer-modified-p modified)
a2535589 309 (goto-char original-point)))
0e4889b2
RS
310
311 (remove-hook 'after-revert-hook 'hexl-after-revert-hook t)
312 (remove-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer t)
8e7df2e6
SE
313 (remove-hook 'post-command-hook 'hexl-follow-ascii-find t)
314 (setq hexl-ascii-overlay nil)
0e4889b2
RS
315
316 (setq write-contents-hooks hexl-mode-old-write-contents-hooks)
317 (setq require-final-newline hexl-mode-old-require-final-newline)
a2535589
JA
318 (setq mode-name hexl-mode-old-mode-name)
319 (use-local-map hexl-mode-old-local-map)
0e4889b2 320 (set-syntax-table hexl-mode-old-syntax-table)
a2535589 321 (setq major-mode hexl-mode-old-major-mode)
8eeac2ce
RS
322 (force-mode-line-update))
323
324(defun hexl-maybe-dehexlify-buffer ()
325 "Convert a hexl format buffer to binary.
326Ask the user for confirmation."
327 (if (y-or-n-p "Convert contents back to binary format? ")
328 (let ((modified (buffer-modified-p))
329 (inhibit-read-only t)
330 (original-point (1+ (hexl-current-address))))
331 (dehexlify-buffer)
95d87237 332 (remove-hook 'write-contents-hooks 'hexl-save-buffer)
8eeac2ce
RS
333 (set-buffer-modified-p modified)
334 (goto-char original-point))))
a2535589 335
6bbb008e 336(defun hexl-current-address (&optional validate)
a2535589
JA
337 "Return current hexl-address."
338 (interactive)
339 (let ((current-column (- (% (point) 68) 11))
340 (hexl-address 0))
6bbb008e
RS
341 (if (< current-column 0)
342 (if validate
343 (error "Point is not on a character in the file")
344 (setq current-column 0)))
345 (setq hexl-address
346 (+ (* (/ (point) 68) 16)
347 (if (>= current-column 41)
348 (- current-column 41)
349 (/ (- current-column (/ current-column 5)) 2))))
a2535589
JA
350 hexl-address))
351
352(defun hexl-address-to-marker (address)
059c2e18 353 "Return buffer position for ADDRESS."
a2535589
JA
354 (interactive "nAddress: ")
355 (+ (* (/ address 16) 68) 11 (/ (* (% address 16) 5) 2)))
356
357(defun hexl-goto-address (address)
358 "Goto hexl-mode (decimal) address ADDRESS.
a2535589
JA
359Signal error if ADDRESS out of range."
360 (interactive "nAddress: ")
361 (if (or (< address 0) (> address hexl-max-address))
19e31f7c 362 (error "Out of hexl region"))
a2535589
JA
363 (goto-char (hexl-address-to-marker address)))
364
365(defun hexl-goto-hex-address (hex-address)
4c8c7ae9 366 "Go to hexl-mode address (hex string) HEX-ADDRESS.
a2535589
JA
367Signal error if HEX-ADDRESS is out of range."
368 (interactive "sHex Address: ")
369 (hexl-goto-address (hexl-hex-string-to-integer hex-address)))
370
371(defun hexl-hex-string-to-integer (hex-string)
372 "Return decimal integer for HEX-STRING."
373 (interactive "sHex number: ")
374 (let ((hex-num 0))
375 (while (not (equal hex-string ""))
376 (setq hex-num (+ (* hex-num 16)
377 (hexl-hex-char-to-integer (string-to-char hex-string))))
378 (setq hex-string (substring hex-string 1)))
379 hex-num))
380
381(defun hexl-octal-string-to-integer (octal-string)
382 "Return decimal integer for OCTAL-STRING."
383 (interactive "sOctal number: ")
384 (let ((oct-num 0))
385 (while (not (equal octal-string ""))
386 (setq oct-num (+ (* oct-num 8)
387 (hexl-oct-char-to-integer
388 (string-to-char octal-string))))
389 (setq octal-string (substring octal-string 1)))
390 oct-num))
391
392;; move point functions
393
394(defun hexl-backward-char (arg)
395 "Move to left ARG bytes (right if ARG negative) in hexl-mode."
396 (interactive "p")
397 (hexl-goto-address (- (hexl-current-address) arg)))
398
399(defun hexl-forward-char (arg)
400 "Move right ARG bytes (left if ARG negative) in hexl-mode."
401 (interactive "p")
402 (hexl-goto-address (+ (hexl-current-address) arg)))
403
404(defun hexl-backward-short (arg)
405 "Move to left ARG shorts (right if ARG negative) in hexl-mode."
406 (interactive "p")
407 (hexl-goto-address (let ((address (hexl-current-address)))
408 (if (< arg 0)
409 (progn
410 (setq arg (- arg))
411 (while (> arg 0)
412 (if (not (equal address (logior address 3)))
413 (if (> address hexl-max-address)
414 (progn
415 (message "End of buffer.")
416 (setq address hexl-max-address))
417 (setq address (logior address 3)))
418 (if (> address hexl-max-address)
419 (progn
420 (message "End of buffer.")
421 (setq address hexl-max-address))
422 (setq address (+ address 4))))
423 (setq arg (1- arg)))
424 (if (> address hexl-max-address)
425 (progn
426 (message "End of buffer.")
427 (setq address hexl-max-address))
428 (setq address (logior address 3))))
429 (while (> arg 0)
430 (if (not (equal address (logand address -4)))
431 (setq address (logand address -4))
432 (if (not (equal address 0))
433 (setq address (- address 4))
434 (message "Beginning of buffer.")))
435 (setq arg (1- arg))))
436 address)))
437
438(defun hexl-forward-short (arg)
439 "Move right ARG shorts (left if ARG negative) in hexl-mode."
440 (interactive "p")
441 (hexl-backward-short (- arg)))
442
443(defun hexl-backward-word (arg)
444 "Move to left ARG words (right if ARG negative) in hexl-mode."
445 (interactive "p")
446 (hexl-goto-address (let ((address (hexl-current-address)))
447 (if (< arg 0)
448 (progn
449 (setq arg (- arg))
450 (while (> arg 0)
451 (if (not (equal address (logior address 7)))
452 (if (> address hexl-max-address)
453 (progn
454 (message "End of buffer.")
455 (setq address hexl-max-address))
456 (setq address (logior address 7)))
457 (if (> address hexl-max-address)
458 (progn
459 (message "End of buffer.")
460 (setq address hexl-max-address))
461 (setq address (+ address 8))))
462 (setq arg (1- arg)))
463 (if (> address hexl-max-address)
464 (progn
465 (message "End of buffer.")
466 (setq address hexl-max-address))
467 (setq address (logior address 7))))
468 (while (> arg 0)
469 (if (not (equal address (logand address -8)))
470 (setq address (logand address -8))
471 (if (not (equal address 0))
472 (setq address (- address 8))
473 (message "Beginning of buffer.")))
474 (setq arg (1- arg))))
475 address)))
476
477(defun hexl-forward-word (arg)
478 "Move right ARG words (left if ARG negative) in hexl-mode."
479 (interactive "p")
480 (hexl-backward-word (- arg)))
481
482(defun hexl-previous-line (arg)
4c8c7ae9
JB
483 "Move vertically up ARG lines [16 bytes] (down if ARG negative) in hexl-mode.
484If there is byte at the target address move to the last byte in that line."
a2535589
JA
485 (interactive "p")
486 (hexl-next-line (- arg)))
487
488(defun hexl-next-line (arg)
4c8c7ae9
JB
489 "Move vertically down ARG lines [16 bytes] (up if ARG negative) in hexl-mode.
490If there is no byte at the target address move to the last byte in that line."
a2535589 491 (interactive "p")
e8a57935 492 (hexl-goto-address (let ((address (+ (hexl-current-address) (* arg 16))))
a2535589
JA
493 (if (and (< arg 0) (< address 0))
494 (progn (message "Out of hexl region.")
495 (setq address
496 (% (hexl-current-address) 16)))
497 (if (and (> address hexl-max-address)
498 (< (% hexl-max-address 16) (% address 16)))
499 (setq address hexl-max-address)
500 (if (> address hexl-max-address)
501 (progn (message "Out of hexl region.")
502 (setq
503 address
504 (+ (logand hexl-max-address -16)
505 (% (hexl-current-address) 16)))))))
506 address)))
507
508(defun hexl-beginning-of-buffer (arg)
4c8c7ae9
JB
509 "Move to the beginning of the hexl buffer.
510Leaves `hexl-mark' at previous position.
511With prefix arg N, puts point N bytes of the way from the true beginning."
a2535589
JA
512 (interactive "p")
513 (push-mark (point))
514 (hexl-goto-address (+ 0 (1- arg))))
515
516(defun hexl-end-of-buffer (arg)
4c8c7ae9 517 "Go to `hexl-max-address' minus ARG."
a2535589
JA
518 (interactive "p")
519 (push-mark (point))
520 (hexl-goto-address (- hexl-max-address (1- arg))))
521
522(defun hexl-beginning-of-line ()
523 "Goto beginning of line in hexl mode."
524 (interactive)
525 (goto-char (+ (* (/ (point) 68) 68) 11)))
526
527(defun hexl-end-of-line ()
528 "Goto end of line in hexl mode."
529 (interactive)
530 (hexl-goto-address (let ((address (logior (hexl-current-address) 15)))
531 (if (> address hexl-max-address)
532 (setq address hexl-max-address))
533 address)))
534
535(defun hexl-scroll-down (arg)
536 "Scroll hexl buffer window upward ARG lines; or near full window if no ARG."
537 (interactive "P")
538 (if (null arg)
539 (setq arg (1- (window-height)))
540 (setq arg (prefix-numeric-value arg)))
541 (hexl-scroll-up (- arg)))
542
543(defun hexl-scroll-up (arg)
544 "Scroll hexl buffer window upward ARG lines; or near full window if no ARG."
545 (interactive "P")
546 (if (null arg)
547 (setq arg (1- (window-height)))
548 (setq arg (prefix-numeric-value arg)))
549 (let ((movement (* arg 16))
550 (address (hexl-current-address)))
551 (if (or (> (+ address movement) hexl-max-address)
552 (< (+ address movement) 0))
553 (message "Out of hexl region.")
554 (hexl-goto-address (+ address movement))
555 (recenter 0))))
556
557(defun hexl-beginning-of-1k-page ()
65e5f4bc 558 "Go to beginning of 1k boundary."
a2535589
JA
559 (interactive)
560 (hexl-goto-address (logand (hexl-current-address) -1024)))
561
562(defun hexl-end-of-1k-page ()
65e5f4bc 563 "Go to end of 1k boundary."
a2535589
JA
564 (interactive)
565 (hexl-goto-address (let ((address (logior (hexl-current-address) 1023)))
566 (if (> address hexl-max-address)
567 (setq address hexl-max-address))
568 address)))
569
570(defun hexl-beginning-of-512b-page ()
65e5f4bc 571 "Go to beginning of 512 byte boundary."
a2535589
JA
572 (interactive)
573 (hexl-goto-address (logand (hexl-current-address) -512)))
574
575(defun hexl-end-of-512b-page ()
65e5f4bc 576 "Go to end of 512 byte boundary."
a2535589
JA
577 (interactive)
578 (hexl-goto-address (let ((address (logior (hexl-current-address) 511)))
579 (if (> address hexl-max-address)
580 (setq address hexl-max-address))
581 address)))
582
583(defun hexl-quoted-insert (arg)
584 "Read next input character and insert it.
585Useful for inserting control characters.
586You may also type up to 3 octal digits, to insert a character with that code"
587 (interactive "p")
588 (hexl-insert-char (read-quoted-char) arg))
589
590;00000000: 0011 2233 4455 6677 8899 aabb ccdd eeff 0123456789ABCDEF
591
f4e3d4eb 592;;;###autoload
a2535589 593(defun hexlify-buffer ()
aa3757b8
RS
594 "Convert a binary buffer to hexl format.
595This discards the buffer's undo information."
a2535589 596 (interactive)
aa3757b8
RS
597 (and buffer-undo-list
598 (or (y-or-n-p "Converting to hexl format discards undo info; ok? ")
599 (error "Aborted")))
600 (setq buffer-undo-list nil)
a749e5e5
EZ
601 ;; Don't decode text in the ASCII part of `hexl' program output.
602 (let ((coding-system-for-read 'raw-text)
0716afa2 603 (coding-system-for-write buffer-file-coding-system)
aa3757b8 604 (buffer-undo-list t))
059c2e18
PR
605 (shell-command-on-region (point-min) (point-max) hexlify-command t)
606 (if (> (point) (hexl-address-to-marker hexl-max-address))
607 (hexl-goto-address hexl-max-address))))
a2535589
JA
608
609(defun dehexlify-buffer ()
aa3757b8
RS
610 "Convert a hexl format buffer to binary.
611This discards the buffer's undo information."
a2535589 612 (interactive)
aa3757b8
RS
613 (and buffer-undo-list
614 (or (y-or-n-p "Converting from hexl format discards undo info; ok? ")
615 (error "Aborted")))
616 (setq buffer-undo-list nil)
a749e5e5 617 (let ((coding-system-for-write 'raw-text)
0716afa2 618 (coding-system-for-read buffer-file-coding-system)
aa3757b8 619 (buffer-undo-list t))
10b501e3 620 (shell-command-on-region (point-min) (point-max) dehexlify-command t)))
a2535589
JA
621
622(defun hexl-char-after-point ()
623 "Return char for ASCII hex digits at point."
686fc9ab
RS
624 (hexl-htoi (char-after (point))
625 (char-after (1+ (point)))))
a2535589
JA
626
627(defun hexl-htoi (lh rh)
628 "Hex (char) LH (char) RH to integer."
629 (+ (* (hexl-hex-char-to-integer lh) 16)
630 (hexl-hex-char-to-integer rh)))
631
632(defun hexl-hex-char-to-integer (character)
633 "Take a char and return its value as if it was a hex digit."
634 (if (and (>= character ?0) (<= character ?9))
635 (- character ?0)
636 (let ((ch (logior character 32)))
637 (if (and (>= ch ?a) (<= ch ?f))
638 (- ch (- ?a 10))
19e31f7c 639 (error "Invalid hex digit `%c'" ch)))))
a2535589
JA
640
641(defun hexl-oct-char-to-integer (character)
642 "Take a char and return its value as if it was a octal digit."
643 (if (and (>= character ?0) (<= character ?7))
644 (- character ?0)
19e31f7c 645 (error "Invalid octal digit `%c'" character)))
a2535589
JA
646
647(defun hexl-printable-character (ch)
648 "Return a displayable string for character CH."
649 (format "%c" (if hexl-iso
650 (if (or (< ch 32) (and (>= ch 127) (< ch 160)))
651 46
652 ch)
653 (if (or (< ch 32) (>= ch 127))
654 46
655 ch))))
656
657(defun hexl-self-insert-command (arg)
658 "Insert this character."
659 (interactive "p")
660 (hexl-insert-char last-command-char arg))
661
662(defun hexl-insert-char (ch num)
663 "Insert a character in a hexl buffer."
6bbb008e 664 (let ((address (hexl-current-address t)))
a2535589 665 (while (> num 0)
6bbb008e
RS
666 (let ((hex-position
667 (+ (* (/ address 16) 68)
668 11
669 (* 2 (% address 16))
670 (/ (% address 16) 2)))
671 (ascii-position
672 (+ (* (/ address 16) 68) 52 (% address 16)))
673 at-ascii-position)
674 (if (= (point) ascii-position)
675 (setq at-ascii-position t))
676 (goto-char hex-position)
677 (delete-char 2)
678 (insert (format "%02x" ch))
679 (goto-char ascii-position)
680 (delete-char 1)
681 (insert (hexl-printable-character ch))
682 (or (eq address hexl-max-address)
683 (setq address (1+ address)))
684 (hexl-goto-address address)
685 (if at-ascii-position
686 (progn
687 (beginning-of-line)
688 (forward-char 51)
689 (forward-char (% address 16)))))
a2535589
JA
690 (setq num (1- num)))))
691
692;; hex conversion
693
694(defun hexl-insert-hex-char (arg)
695 "Insert a ASCII char ARG times at point for a given hexadecimal number."
696 (interactive "p")
697 (let ((num (hexl-hex-string-to-integer (read-string "Hex number: "))))
698 (if (or (> num 255) (< num 0))
19e31f7c 699 (error "Hex number out of range")
a2535589
JA
700 (hexl-insert-char num arg))))
701
9f6bff44
GM
702(defun hexl-insert-hex-string (str arg)
703 "Insert hexadecimal string STR at point ARG times.
704Embedded whitespace, dashes, and periods in the string are ignored."
705 (interactive "sHex string: \np")
706 (setq str (replace-regexp-in-string "[- \t.]" "" str))
707 (let ((chars '()))
708 (let ((len (length str))
709 (idx 0))
710 (if (eq (logand len 1) 1)
711 (let ((num (hexl-hex-string-to-integer (substring str 0 1))))
712 (setq chars (cons num chars))
713 (setq idx 1)))
714 (while (< idx len)
715 (let* ((nidx (+ idx 2))
716 (num (hexl-hex-string-to-integer (substring str idx nidx))))
717 (setq chars (cons num chars))
718 (setq idx nidx))))
719 (setq chars (nreverse chars))
720 (while (> arg 0)
721 (let ((chars chars))
722 (while chars
723 (hexl-insert-char (car chars) 1)
724 (setq chars (cdr chars))))
725 (setq arg (- arg 1)))))
726
a2535589
JA
727(defun hexl-insert-decimal-char (arg)
728 "Insert a ASCII char ARG times at point for a given decimal number."
729 (interactive "p")
730 (let ((num (string-to-int (read-string "Decimal Number: "))))
731 (if (or (> num 255) (< num 0))
19e31f7c 732 (error "Decimal number out of range")
a2535589
JA
733 (hexl-insert-char num arg))))
734
735(defun hexl-insert-octal-char (arg)
736 "Insert a ASCII char ARG times at point for a given octal number."
737 (interactive "p")
738 (let ((num (hexl-octal-string-to-integer (read-string "Octal Number: "))))
739 (if (or (> num 255) (< num 0))
19e31f7c 740 (error "Decimal number out of range")
a2535589
JA
741 (hexl-insert-char num arg))))
742
db6c5b92
SE
743(defun hexl-follow-ascii (&optional arg)
744 "Toggle following ASCII in Hexl buffers.
745With prefix ARG, turn on following if and only if ARG is positive.
746When following is enabled, the ASCII character corresponding to the
747element under the point is highlighted.
748Customize the variable `hexl-follow-ascii' to disable this feature."
749 (interactive "P")
750 (let ((on-p (if arg
751 (> (prefix-numeric-value arg) 0)
752 (not hexl-ascii-overlay))))
753
754 (make-local-hook 'post-command-hook)
755
756 (if on-p
757 ;; turn it on
758 (if (not hexl-ascii-overlay)
759 (progn
760 (setq hexl-ascii-overlay (make-overlay 1 1)
761 hexl-follow-ascii t)
762 (overlay-put hexl-ascii-overlay 'face 'highlight)
763 (add-hook 'post-command-hook 'hexl-follow-ascii-find nil t)))
764 ;; turn it off
765 (if hexl-ascii-overlay
766 (progn
767 (delete-overlay hexl-ascii-overlay)
768 (setq hexl-ascii-overlay nil
769 hexl-follow-ascii nil)
770 (remove-hook 'post-command-hook 'hexl-follow-ascii-find t)
771 )))))
772
773(defun hexl-follow-ascii-find ()
774 "Find and highlight the ASCII element corresponding to current point."
775 (let ((pos (+ 51
776 (- (point) (current-column))
777 (mod (hexl-current-address) 16))))
778 (move-overlay hexl-ascii-overlay pos (1+ pos))
779 ))
780
a2535589
JA
781;; startup stuff.
782
783(if hexl-mode-map
784 nil
ae2d451b
RS
785 (setq hexl-mode-map (make-sparse-keymap))
786
787 (define-key hexl-mode-map [left] 'hexl-backward-char)
788 (define-key hexl-mode-map [right] 'hexl-forward-char)
789 (define-key hexl-mode-map [up] 'hexl-previous-line)
790 (define-key hexl-mode-map [down] 'hexl-next-line)
791 (define-key hexl-mode-map [M-left] 'hexl-backward-short)
792 (define-key hexl-mode-map [M-right] 'hexl-forward-short)
793 (define-key hexl-mode-map [next] 'hexl-scroll-up)
794 (define-key hexl-mode-map [prior] 'hexl-scroll-down)
795 (define-key hexl-mode-map [home] 'hexl-beginning-of-buffer)
796 (define-key hexl-mode-map [deletechar] 'undefined)
797 (define-key hexl-mode-map [deleteline] 'undefined)
798 (define-key hexl-mode-map [insertline] 'undefined)
799 (define-key hexl-mode-map [S-delete] 'undefined)
800 (define-key hexl-mode-map "\177" 'undefined)
801
802 (define-key hexl-mode-map "\C-a" 'hexl-beginning-of-line)
803 (define-key hexl-mode-map "\C-b" 'hexl-backward-char)
804 (define-key hexl-mode-map "\C-d" 'undefined)
805 (define-key hexl-mode-map "\C-e" 'hexl-end-of-line)
806 (define-key hexl-mode-map "\C-f" 'hexl-forward-char)
807
808 (if (not (eq (key-binding (char-to-string help-char)) 'help-command))
809 (define-key hexl-mode-map (char-to-string help-char) 'undefined))
810
811 (define-key hexl-mode-map "\C-i" 'hexl-self-insert-command)
812 (define-key hexl-mode-map "\C-j" 'hexl-self-insert-command)
813 (define-key hexl-mode-map "\C-k" 'undefined)
814 (define-key hexl-mode-map "\C-m" 'hexl-self-insert-command)
815 (define-key hexl-mode-map "\C-n" 'hexl-next-line)
816 (define-key hexl-mode-map "\C-o" 'undefined)
817 (define-key hexl-mode-map "\C-p" 'hexl-previous-line)
818 (define-key hexl-mode-map "\C-q" 'hexl-quoted-insert)
819 (define-key hexl-mode-map "\C-t" 'undefined)
820 (define-key hexl-mode-map "\C-v" 'hexl-scroll-up)
821 (define-key hexl-mode-map "\C-w" 'undefined)
822 (define-key hexl-mode-map "\C-y" 'undefined)
823
824 (let ((ch 32))
825 (while (< ch 127)
826 (define-key hexl-mode-map (format "%c" ch) 'hexl-self-insert-command)
827 (setq ch (1+ ch))))
828
829 (define-key hexl-mode-map "\e\C-a" 'hexl-beginning-of-512b-page)
830 (define-key hexl-mode-map "\e\C-b" 'hexl-backward-short)
ae2d451b
RS
831 (define-key hexl-mode-map "\e\C-d" 'hexl-insert-decimal-char)
832 (define-key hexl-mode-map "\e\C-e" 'hexl-end-of-512b-page)
833 (define-key hexl-mode-map "\e\C-f" 'hexl-forward-short)
ae2d451b
RS
834 (define-key hexl-mode-map "\e\C-i" 'undefined)
835 (define-key hexl-mode-map "\e\C-j" 'undefined)
836 (define-key hexl-mode-map "\e\C-k" 'undefined)
ae2d451b 837 (define-key hexl-mode-map "\e\C-o" 'hexl-insert-octal-char)
ae2d451b 838 (define-key hexl-mode-map "\e\C-q" 'undefined)
ae2d451b 839 (define-key hexl-mode-map "\e\C-t" 'undefined)
ae2d451b 840 (define-key hexl-mode-map "\e\C-x" 'hexl-insert-hex-char)
ae2d451b
RS
841 (define-key hexl-mode-map "\eb" 'hexl-backward-word)
842 (define-key hexl-mode-map "\ec" 'undefined)
843 (define-key hexl-mode-map "\ed" 'undefined)
ae2d451b
RS
844 (define-key hexl-mode-map "\ef" 'hexl-forward-word)
845 (define-key hexl-mode-map "\eg" 'hexl-goto-hex-address)
ae2d451b
RS
846 (define-key hexl-mode-map "\ei" 'undefined)
847 (define-key hexl-mode-map "\ej" 'hexl-goto-address)
848 (define-key hexl-mode-map "\ek" 'undefined)
849 (define-key hexl-mode-map "\el" 'undefined)
ae2d451b 850 (define-key hexl-mode-map "\eq" 'undefined)
ae2d451b
RS
851 (define-key hexl-mode-map "\es" 'undefined)
852 (define-key hexl-mode-map "\et" 'undefined)
853 (define-key hexl-mode-map "\eu" 'undefined)
854 (define-key hexl-mode-map "\ev" 'hexl-scroll-down)
855 (define-key hexl-mode-map "\ey" 'undefined)
856 (define-key hexl-mode-map "\ez" 'undefined)
857 (define-key hexl-mode-map "\e<" 'hexl-beginning-of-buffer)
858 (define-key hexl-mode-map "\e>" 'hexl-end-of-buffer)
859
860 (define-key hexl-mode-map "\C-c\C-c" 'hexl-mode-exit)
861
862 (define-key hexl-mode-map "\C-x[" 'hexl-beginning-of-1k-page)
863 (define-key hexl-mode-map "\C-x]" 'hexl-end-of-1k-page)
864 (define-key hexl-mode-map "\C-x\C-p" 'undefined)
865 (define-key hexl-mode-map "\C-x\C-s" 'hexl-save-buffer)
866 (define-key hexl-mode-map "\C-x\C-t" 'undefined))
a2535589 867
19e31f7c
RS
868(provide 'hexl)
869
1a06eabd 870;;; hexl.el ends here