HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
File customized.
[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
a22f4c7d 80 (format "%s%s %s" exec-directory hexl-program hexl-options)
00ed33e7
RS		 81 "The command to use to hexlify a buffer."
82 :type 'string
83 :group 'hexl)
a2535589 84
00ed33e7 85(defcustom dehexlify-command
a22f4c7d 86 (format "%s%s -de %s" exec-directory hexl-program hexl-options)
00ed33e7
RS		 87 "The command to use to unhexlify a buffer."
88 :type 'string
89 :group 'hexl)
a2535589 90
db6c5b92
SE		 91(defcustom hexl-follow-ascii t
92 "If non-nil then highlight the ASCII character corresponding to point."
93 :type 'boolean
94 :group 'hexl)
95
a2535589
JA		 96(defvar hexl-max-address 0
97 "Maximum offset into hexl buffer.")
98
99(defvar hexl-mode-map nil)
100
f39c6650
RS		 101(defvar hexl-mode-old-local-map)
102(defvar hexl-mode-old-mode-name)
103(defvar hexl-mode-old-major-mode)
0e4889b2
RS		 104(defvar hexl-mode-old-write-contents-hooks)
105(defvar hexl-mode-old-require-final-newline)
106(defvar hexl-mode-old-syntax-table)
f39c6650 107
db6c5b92
SE		 108(defvar hexl-ascii-overlay nil
109 "Overlay used to highlight ASCII element corresponding to current point.")
110(make-variable-buffer-local 'hexl-ascii-overlay)
111
a2535589
JA		 112;; routines
113
2d902813
RS		 114(put 'hexl-mode 'mode-class 'special)
115
31c75fa7 116;;;###autoload
a2535589
JA		 117(defun hexl-mode (&optional arg)
118 "\\<hexl-mode-map>
e41b2db1 119A major mode for editing binary files in hex dump format.
a2535589
JA		 120
121This function automatically converts a buffer into the hexl format
122using the function `hexlify-buffer'.
123
8a1281b5 124Each line in the buffer has an \"address\" (displayed in hexadecimal)
a2535589
JA		 125representing the offset into the file that the characters on this line
126are at and 16 characters from the file (displayed as hexadecimal
127values grouped every 16 bits) and as their ASCII values.
128
129If any of the characters (displayed as ASCII characters) are
130unprintable (control or meta characters) they will be replaced as
131periods.
132
8a1281b5
RS		 133If `hexl-mode' is invoked with an argument the buffer is assumed to be
134in hexl format.
a2535589
JA		 135
136A sample format:
137
138 HEX ADDR: 0001 0203 0405 0607 0809 0a0b 0c0d 0e0f ASCII-TEXT
139 -------- ---- ---- ---- ---- ---- ---- ---- ---- ----------------
140 00000000: 5468 6973 2069 7320 6865 786c 2d6d 6f64 This is hexl-mod
141 00000010: 652e 2020 4561 6368 206c 696e 6520 7265 e. Each line re
142 00000020: 7072 6573 656e 7473 2031 3620 6279 7465 presents 16 byte
143 00000030: 7320 6173 2068 6578 6164 6563 696d 616c s as hexadecimal
144 00000040: 2041 5343 4949 0a61 6e64 2070 7269 6e74 ASCII.and print
145 00000050: 6162 6c65 2041 5343 4949 2063 6861 7261 able ASCII chara
146 00000060: 6374 6572 732e 2020 416e 7920 636f 6e74 cters. Any cont
147 00000070: 726f 6c20 6f72 206e 6f6e 2d41 5343 4949 rol or non-ASCII
148 00000080: 2063 6861 7261 6374 6572 730a 6172 6520 characters.are
149 00000090: 6469 7370 6c61 7965 6420 6173 2070 6572 displayed as per
150 000000a0: 696f 6473 2069 6e20 7468 6520 7072 696e iods in the prin
151 000000b0: 7461 626c 6520 6368 6172 6163 7465 7220 table character
152 000000c0: 7265 6769 6f6e 2e0a region..
153
154Movement is as simple as movement in a normal emacs text buffer. Most
155cursor movement bindings are the same (ie. Use \\[hexl-backward-char], \\[hexl-forward-char], \\[hexl-next-line], and \\[hexl-previous-line]
156to move the cursor left, right, down, and up).
157
158Advanced cursor movement commands (ala \\[hexl-beginning-of-line], \\[hexl-end-of-line], \\[hexl-beginning-of-buffer], and \\[hexl-end-of-buffer]) are
159also supported.
160
161There are several ways to change text in hexl mode:
162
163ASCII characters (character between space (0x20) and tilde (0x7E)) are
164bound to self-insert so you can simply type the character and it will
165insert itself (actually overstrike) into the buffer.
166
167\\[hexl-quoted-insert] followed by another keystroke allows you to insert the key even if
168it isn't bound to self-insert. An octal number can be supplied in place
169of another key to insert the octal number's ASCII representation.
170
171\\[hexl-insert-hex-char] will insert a given hexadecimal value (if it is between 0 and 0xFF)
172into the buffer at the current point.
173
174\\[hexl-insert-octal-char] will insert a given octal value (if it is between 0 and 0377)
175into the buffer at the current point.
176
177\\[hexl-insert-decimal-char] will insert a given decimal value (if it is between 0 and 255)
178into the buffer at the current point.
179
a2535589
JA		 180\\[hexl-mode-exit] will exit hexl-mode.
181
31c75fa7
RS		 182Note: saving the file with any of the usual Emacs commands
183will actually convert it back to binary format while saving.
a2535589
JA		 184
185You can use \\[hexl-find-file] to visit a file in hexl-mode.
186
187\\[describe-bindings] for advanced commands."
188 (interactive "p")
189 (if (eq major-mode 'hexl-mode)
0e4889b2
RS		 190 (error "You are already in hexl mode")
191
753c1309
RS		 192 (let ((modified (buffer-modified-p))
193 (inhibit-read-only t)
194 (original-point (1- (point)))
195 max-address)
196 (and (eobp) (not (bobp))
197 (setq original-point (1- original-point)))
198 (if (not (or (eq arg 1) (not arg)))
199 ;; if no argument then we guess at hexl-max-address
200 (setq max-address (+ (* (/ (1- (buffer-size)) 68) 16) 15))
201 (setq max-address (1- (buffer-size)))
202 (hexlify-buffer)
203 (set-buffer-modified-p modified))
204 (make-local-variable 'hexl-max-address)
205 (setq hexl-max-address max-address)
206 (hexl-goto-address original-point))
207
0e4889b2
RS		 208 ;; We do not turn off the old major mode; instead we just
209 ;; override most of it. That way, we can restore it perfectly.
a2535589
JA		 210 (make-local-variable 'hexl-mode-old-local-map)
211 (setq hexl-mode-old-local-map (current-local-map))
212 (use-local-map hexl-mode-map)
213
214 (make-local-variable 'hexl-mode-old-mode-name)
215 (setq hexl-mode-old-mode-name mode-name)
216 (setq mode-name "Hexl")
217
218 (make-local-variable 'hexl-mode-old-major-mode)
219 (setq hexl-mode-old-major-mode major-mode)
220 (setq major-mode 'hexl-mode)
221
0e4889b2
RS		 222 (make-local-variable 'hexl-mode-old-syntax-table)
223 (setq hexl-mode-old-syntax-table (syntax-table))
224 (set-syntax-table (standard-syntax-table))
225
226 (make-local-variable 'hexl-mode-old-write-contents-hooks)
227 (setq hexl-mode-old-write-contents-hooks write-contents-hooks)
31c75fa7 228 (make-local-variable 'write-contents-hooks)
c6fcafde 229 (add-hook 'write-contents-hooks 'hexl-save-buffer)
31c75fa7 230
0e4889b2
RS		 231 (make-local-variable 'hexl-mode-old-require-final-newline)
232 (setq hexl-mode-old-require-final-newline require-final-newline)
233 (make-local-variable 'require-final-newline)
234 (setq require-final-newline nil)
235
236 ;; Add hooks to rehexlify or dehexlify on various events.
c3de2bf0
RS		 237 (make-local-hook 'after-revert-hook)
238 (add-hook 'after-revert-hook 'hexl-after-revert-hook nil t)
239
0e4889b2 240 (make-local-hook 'change-major-mode-hook)
db6c5b92
SE		 241 (add-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer nil t)
242
243 (if hexl-follow-ascii (hexl-follow-ascii 1)))
7bfff21e 244 (run-hooks 'hexl-mode-hook))
a2535589 245
c3de2bf0
RS		 246(defun hexl-after-revert-hook ()
247 (hexlify-buffer)
248 (set-buffer-modified-p nil))
249
ac2e902d
JB		 250(defvar hexl-in-save-buffer nil)
251
a2535589
JA		 252(defun hexl-save-buffer ()
253 "Save a hexl format buffer as binary in visited file if modified."
254 (interactive)
ac2e902d
JB		 255 (if hexl-in-save-buffer nil
256 (set-buffer-modified-p (if (buffer-modified-p)
257 (save-excursion
258 (let ((buf (generate-new-buffer " hexl"))
259 (name (buffer-name))
260 (file-name (buffer-file-name))
261 (start (point-min))
262 (end (point-max))
263 modified)
264 (set-buffer buf)
265 (insert-buffer-substring name start end)
266 (set-buffer name)
267 (dehexlify-buffer)
268 ;; Prevent infinite recursion.
338992a5 269 (let ((hexl-in-save-buffer t))
ac2e902d
JB		 270 (save-buffer))
271 (setq modified (buffer-modified-p))
272 (delete-region (point-min) (point-max))
273 (insert-buffer-substring buf start end)
274 (kill-buffer buf)
275 modified))
276 (message "(No changes need to be saved)")
277 nil))
278 ;; Return t to indicate we have saved t
279 t))
a2535589 280
31c75fa7 281;;;###autoload
a2535589
JA		 282(defun hexl-find-file (filename)
283 "Edit file FILENAME in hexl-mode.
a2535589
JA		 284Switch to a buffer visiting file FILENAME, creating one in none exists."
285 (interactive "fFilename: ")
338992a5 286 (find-file-literally filename)
a2535589
JA		 287 (if (not (eq major-mode 'hexl-mode))
288 (hexl-mode)))
289
290(defun hexl-mode-exit (&optional arg)
31c75fa7 291 "Exit Hexl mode, returning to previous mode.
a2535589
JA		 292With arg, don't unhexlify buffer."
293 (interactive "p")
294 (if (or (eq arg 1) (not arg))
295 (let ((modified (buffer-modified-p))
900014dd 296 (inhibit-read-only t)
a2535589 297 (original-point (1+ (hexl-current-address))))
a2535589 298 (dehexlify-buffer)
95d87237 299 (remove-hook 'write-contents-hooks 'hexl-save-buffer)
a2535589 300 (set-buffer-modified-p modified)
a2535589 301 (goto-char original-point)))
0e4889b2
RS		 302
303 (remove-hook 'after-revert-hook 'hexl-after-revert-hook t)
304 (remove-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer t)
305
306 (setq write-contents-hooks hexl-mode-old-write-contents-hooks)
307 (setq require-final-newline hexl-mode-old-require-final-newline)
a2535589
JA		 308 (setq mode-name hexl-mode-old-mode-name)
309 (use-local-map hexl-mode-old-local-map)
0e4889b2 310 (set-syntax-table hexl-mode-old-syntax-table)
a2535589 311 (setq major-mode hexl-mode-old-major-mode)
8eeac2ce
RS		 312 (force-mode-line-update))
313
314(defun hexl-maybe-dehexlify-buffer ()
315 "Convert a hexl format buffer to binary.
316Ask the user for confirmation."
317 (if (y-or-n-p "Convert contents back to binary format? ")
318 (let ((modified (buffer-modified-p))
319 (inhibit-read-only t)
320 (original-point (1+ (hexl-current-address))))
321 (dehexlify-buffer)
95d87237 322 (remove-hook 'write-contents-hooks 'hexl-save-buffer)
8eeac2ce
RS		 323 (set-buffer-modified-p modified)
324 (goto-char original-point))))
a2535589 325
6bbb008e 326(defun hexl-current-address (&optional validate)
a2535589
JA		 327 "Return current hexl-address."
328 (interactive)
329 (let ((current-column (- (% (point) 68) 11))
330 (hexl-address 0))
6bbb008e
RS		 331 (if (< current-column 0)
332 (if validate
333 (error "Point is not on a character in the file")
334 (setq current-column 0)))
335 (setq hexl-address
336 (+ (* (/ (point) 68) 16)
337 (if (>= current-column 41)
338 (- current-column 41)
339 (/ (- current-column (/ current-column 5)) 2))))
a2535589
JA		 340 hexl-address))
341
342(defun hexl-address-to-marker (address)
343 "Return marker for ADDRESS."
344 (interactive "nAddress: ")
345 (+ (* (/ address 16) 68) 11 (/ (* (% address 16) 5) 2)))
346
347(defun hexl-goto-address (address)
348 "Goto hexl-mode (decimal) address ADDRESS.
a2535589
JA		 349Signal error if ADDRESS out of range."
350 (interactive "nAddress: ")
351 (if (or (< address 0) (> address hexl-max-address))
19e31f7c 352 (error "Out of hexl region"))
a2535589
JA		 353 (goto-char (hexl-address-to-marker address)))
354
355(defun hexl-goto-hex-address (hex-address)
4c8c7ae9 356 "Go to hexl-mode address (hex string) HEX-ADDRESS.
a2535589
JA		 357Signal error if HEX-ADDRESS is out of range."
358 (interactive "sHex Address: ")
359 (hexl-goto-address (hexl-hex-string-to-integer hex-address)))
360
361(defun hexl-hex-string-to-integer (hex-string)
362 "Return decimal integer for HEX-STRING."
363 (interactive "sHex number: ")
364 (let ((hex-num 0))
365 (while (not (equal hex-string ""))
366 (setq hex-num (+ (* hex-num 16)
367 (hexl-hex-char-to-integer (string-to-char hex-string))))
368 (setq hex-string (substring hex-string 1)))
369 hex-num))
370
371(defun hexl-octal-string-to-integer (octal-string)
372 "Return decimal integer for OCTAL-STRING."
373 (interactive "sOctal number: ")
374 (let ((oct-num 0))
375 (while (not (equal octal-string ""))
376 (setq oct-num (+ (* oct-num 8)
377 (hexl-oct-char-to-integer
378 (string-to-char octal-string))))
379 (setq octal-string (substring octal-string 1)))
380 oct-num))
381
382;; move point functions
383
384(defun hexl-backward-char (arg)
385 "Move to left ARG bytes (right if ARG negative) in hexl-mode."
386 (interactive "p")
387 (hexl-goto-address (- (hexl-current-address) arg)))
388
389(defun hexl-forward-char (arg)
390 "Move right ARG bytes (left if ARG negative) in hexl-mode."
391 (interactive "p")
392 (hexl-goto-address (+ (hexl-current-address) arg)))
393
394(defun hexl-backward-short (arg)
395 "Move to left ARG shorts (right if ARG negative) in hexl-mode."
396 (interactive "p")
397 (hexl-goto-address (let ((address (hexl-current-address)))
398 (if (< arg 0)
399 (progn
400 (setq arg (- arg))
401 (while (> arg 0)
402 (if (not (equal address (logior address 3)))
403 (if (> address hexl-max-address)
404 (progn
405 (message "End of buffer.")
406 (setq address hexl-max-address))
407 (setq address (logior address 3)))
408 (if (> address hexl-max-address)
409 (progn
410 (message "End of buffer.")
411 (setq address hexl-max-address))
412 (setq address (+ address 4))))
413 (setq arg (1- arg)))
414 (if (> address hexl-max-address)
415 (progn
416 (message "End of buffer.")
417 (setq address hexl-max-address))
418 (setq address (logior address 3))))
419 (while (> arg 0)
420 (if (not (equal address (logand address -4)))
421 (setq address (logand address -4))
422 (if (not (equal address 0))
423 (setq address (- address 4))
424 (message "Beginning of buffer.")))
425 (setq arg (1- arg))))
426 address)))
427
428(defun hexl-forward-short (arg)
429 "Move right ARG shorts (left if ARG negative) in hexl-mode."
430 (interactive "p")
431 (hexl-backward-short (- arg)))
432
433(defun hexl-backward-word (arg)
434 "Move to left ARG words (right if ARG negative) in hexl-mode."
435 (interactive "p")
436 (hexl-goto-address (let ((address (hexl-current-address)))
437 (if (< arg 0)
438 (progn
439 (setq arg (- arg))
440 (while (> arg 0)
441 (if (not (equal address (logior address 7)))
442 (if (> address hexl-max-address)
443 (progn
444 (message "End of buffer.")
445 (setq address hexl-max-address))
446 (setq address (logior address 7)))
447 (if (> address hexl-max-address)
448 (progn
449 (message "End of buffer.")
450 (setq address hexl-max-address))
451 (setq address (+ address 8))))
452 (setq arg (1- arg)))
453 (if (> address hexl-max-address)
454 (progn
455 (message "End of buffer.")
456 (setq address hexl-max-address))
457 (setq address (logior address 7))))
458 (while (> arg 0)
459 (if (not (equal address (logand address -8)))
460 (setq address (logand address -8))
461 (if (not (equal address 0))
462 (setq address (- address 8))
463 (message "Beginning of buffer.")))
464 (setq arg (1- arg))))
465 address)))
466
467(defun hexl-forward-word (arg)
468 "Move right ARG words (left if ARG negative) in hexl-mode."
469 (interactive "p")
470 (hexl-backward-word (- arg)))
471
472(defun hexl-previous-line (arg)
4c8c7ae9
JB		 473 "Move vertically up ARG lines [16 bytes] (down if ARG negative) in hexl-mode.
474If there is byte at the target address move to the last byte in that line."
a2535589
JA		 475 (interactive "p")
476 (hexl-next-line (- arg)))
477
478(defun hexl-next-line (arg)
4c8c7ae9
JB		 479 "Move vertically down ARG lines [16 bytes] (up if ARG negative) in hexl-mode.
480If there is no byte at the target address move to the last byte in that line."
a2535589 481 (interactive "p")
e8a57935 482 (hexl-goto-address (let ((address (+ (hexl-current-address) (* arg 16))))
a2535589
JA		 483 (if (and (< arg 0) (< address 0))
484 (progn (message "Out of hexl region.")
485 (setq address
486 (% (hexl-current-address) 16)))
487 (if (and (> address hexl-max-address)
488 (< (% hexl-max-address 16) (% address 16)))
489 (setq address hexl-max-address)
490 (if (> address hexl-max-address)
491 (progn (message "Out of hexl region.")
492 (setq
493 address
494 (+ (logand hexl-max-address -16)
495 (% (hexl-current-address) 16)))))))
496 address)))
497
498(defun hexl-beginning-of-buffer (arg)
4c8c7ae9
JB		 499 "Move to the beginning of the hexl buffer.
500Leaves `hexl-mark' at previous position.
501With prefix arg N, puts point N bytes of the way from the true beginning."
a2535589
JA		 502 (interactive "p")
503 (push-mark (point))
504 (hexl-goto-address (+ 0 (1- arg))))
505
506(defun hexl-end-of-buffer (arg)
4c8c7ae9 507 "Go to `hexl-max-address' minus ARG."
a2535589
JA		 508 (interactive "p")
509 (push-mark (point))
510 (hexl-goto-address (- hexl-max-address (1- arg))))
511
512(defun hexl-beginning-of-line ()
513 "Goto beginning of line in hexl mode."
514 (interactive)
515 (goto-char (+ (* (/ (point) 68) 68) 11)))
516
517(defun hexl-end-of-line ()
518 "Goto end of line in hexl mode."
519 (interactive)
520 (hexl-goto-address (let ((address (logior (hexl-current-address) 15)))
521 (if (> address hexl-max-address)
522 (setq address hexl-max-address))
523 address)))
524
525(defun hexl-scroll-down (arg)
526 "Scroll hexl buffer window upward ARG lines; or near full window if no ARG."
527 (interactive "P")
528 (if (null arg)
529 (setq arg (1- (window-height)))
530 (setq arg (prefix-numeric-value arg)))
531 (hexl-scroll-up (- arg)))
532
533(defun hexl-scroll-up (arg)
534 "Scroll hexl buffer window upward ARG lines; or near full window if no ARG."
535 (interactive "P")
536 (if (null arg)
537 (setq arg (1- (window-height)))
538 (setq arg (prefix-numeric-value arg)))
539 (let ((movement (* arg 16))
540 (address (hexl-current-address)))
541 (if (or (> (+ address movement) hexl-max-address)
542 (< (+ address movement) 0))
543 (message "Out of hexl region.")
544 (hexl-goto-address (+ address movement))
545 (recenter 0))))
546
547(defun hexl-beginning-of-1k-page ()
65e5f4bc 548 "Go to beginning of 1k boundary."
a2535589
JA		 549 (interactive)
550 (hexl-goto-address (logand (hexl-current-address) -1024)))
551
552(defun hexl-end-of-1k-page ()
65e5f4bc 553 "Go to end of 1k boundary."
a2535589
JA		 554 (interactive)
555 (hexl-goto-address (let ((address (logior (hexl-current-address) 1023)))
556 (if (> address hexl-max-address)
557 (setq address hexl-max-address))
558 address)))
559
560(defun hexl-beginning-of-512b-page ()
65e5f4bc 561 "Go to beginning of 512 byte boundary."
a2535589
JA		 562 (interactive)
563 (hexl-goto-address (logand (hexl-current-address) -512)))
564
565(defun hexl-end-of-512b-page ()
65e5f4bc 566 "Go to end of 512 byte boundary."
a2535589
JA		 567 (interactive)
568 (hexl-goto-address (let ((address (logior (hexl-current-address) 511)))
569 (if (> address hexl-max-address)
570 (setq address hexl-max-address))
571 address)))
572
573(defun hexl-quoted-insert (arg)
574 "Read next input character and insert it.
575Useful for inserting control characters.
576You may also type up to 3 octal digits, to insert a character with that code"
577 (interactive "p")
578 (hexl-insert-char (read-quoted-char) arg))
579
580;00000000: 0011 2233 4455 6677 8899 aabb ccdd eeff 0123456789ABCDEF
581
f4e3d4eb 582;;;###autoload
a2535589 583(defun hexlify-buffer ()
aa3757b8
RS		 584 "Convert a binary buffer to hexl format.
585This discards the buffer's undo information."
a2535589 586 (interactive)
aa3757b8
RS		 587 (and buffer-undo-list
588 (or (y-or-n-p "Converting to hexl format discards undo info; ok? ")
589 (error "Aborted")))
590 (setq buffer-undo-list nil)
1fa65e2f 591 (let ((binary-process-output nil) ; for Ms-Dos
338992a5 592 (binary-process-input buffer-file-type)
ce136481
RS		 593 ;; If the buffer was read with EOL conversions, be sure to use the
594 ;; same conversions when passing the region to the `hexl' program.
595 (coding-system-for-write
596 (let ((eol-type (coding-system-eol-type buffer-file-coding-system)))
597 (cond ((eq eol-type 1)
598 'raw-text-dos)
599 ((eq eol-type 2)
600 'raw-text-mac)
601 ((eq eol-type 0)
602 'raw-text-unix)
603 (t 'no-conversion))))
aa3757b8 604 (buffer-undo-list t))
1fa65e2f 605 (shell-command-on-region (point-min) (point-max) hexlify-command t)))
a2535589
JA		 606
607(defun dehexlify-buffer ()
aa3757b8
RS		 608 "Convert a hexl format buffer to binary.
609This discards the buffer's undo information."
a2535589 610 (interactive)
aa3757b8
RS		 611 (and buffer-undo-list
612 (or (y-or-n-p "Converting from hexl format discards undo info; ok? ")
613 (error "Aborted")))
614 (setq buffer-undo-list nil)
338992a5 615 (let ((binary-process-output buffer-file-type) ; for Ms-Dos
aa3757b8 616 (binary-process-input nil)
ce136481 617 (coding-system-for-read 'raw-text)
aa3757b8 618 (buffer-undo-list t))
10b501e3 619 (shell-command-on-region (point-min) (point-max) dehexlify-command t)))
a2535589
JA		 620
621(defun hexl-char-after-point ()
622 "Return char for ASCII hex digits at point."
686fc9ab
RS		 623 (hexl-htoi (char-after (point))
624 (char-after (1+ (point)))))
a2535589
JA		 625
626(defun hexl-htoi (lh rh)
627 "Hex (char) LH (char) RH to integer."
628 (+ (* (hexl-hex-char-to-integer lh) 16)
629 (hexl-hex-char-to-integer rh)))
630
631(defun hexl-hex-char-to-integer (character)
632 "Take a char and return its value as if it was a hex digit."
633 (if (and (>= character ?0) (<= character ?9))
634 (- character ?0)
635 (let ((ch (logior character 32)))
636 (if (and (>= ch ?a) (<= ch ?f))
637 (- ch (- ?a 10))
19e31f7c 638 (error "Invalid hex digit `%c'" ch)))))
a2535589
JA		 639
640(defun hexl-oct-char-to-integer (character)
641 "Take a char and return its value as if it was a octal digit."
642 (if (and (>= character ?0) (<= character ?7))
643 (- character ?0)
19e31f7c 644 (error "Invalid octal digit `%c'" character)))
a2535589
JA		 645
646(defun hexl-printable-character (ch)
647 "Return a displayable string for character CH."
648 (format "%c" (if hexl-iso
649 (if (or (< ch 32) (and (>= ch 127) (< ch 160)))
650 46
651 ch)
652 (if (or (< ch 32) (>= ch 127))
653 46
654 ch))))
655
656(defun hexl-self-insert-command (arg)
657 "Insert this character."
658 (interactive "p")
659 (hexl-insert-char last-command-char arg))
660
661(defun hexl-insert-char (ch num)
662 "Insert a character in a hexl buffer."
6bbb008e 663 (let ((address (hexl-current-address t)))
a2535589 664 (while (> num 0)
6bbb008e
RS		 665 (let ((hex-position
666 (+ (* (/ address 16) 68)
667 11
668 (* 2 (% address 16))
669 (/ (% address 16) 2)))
670 (ascii-position
671 (+ (* (/ address 16) 68) 52 (% address 16)))
672 at-ascii-position)
673 (if (= (point) ascii-position)
674 (setq at-ascii-position t))
675 (goto-char hex-position)
676 (delete-char 2)
677 (insert (format "%02x" ch))
678 (goto-char ascii-position)
679 (delete-char 1)
680 (insert (hexl-printable-character ch))
681 (or (eq address hexl-max-address)
682 (setq address (1+ address)))
683 (hexl-goto-address address)
684 (if at-ascii-position
685 (progn
686 (beginning-of-line)
687 (forward-char 51)
688 (forward-char (% address 16)))))
a2535589
JA		 689 (setq num (1- num)))))
690
691;; hex conversion
692
693(defun hexl-insert-hex-char (arg)
694 "Insert a ASCII char ARG times at point for a given hexadecimal number."
695 (interactive "p")
696 (let ((num (hexl-hex-string-to-integer (read-string "Hex number: "))))
697 (if (or (> num 255) (< num 0))
19e31f7c 698 (error "Hex number out of range")
a2535589
JA		 699 (hexl-insert-char num arg))))
700
701(defun hexl-insert-decimal-char (arg)
702 "Insert a ASCII char ARG times at point for a given decimal number."
703 (interactive "p")
704 (let ((num (string-to-int (read-string "Decimal Number: "))))
705 (if (or (> num 255) (< num 0))
19e31f7c 706 (error "Decimal number out of range")
a2535589
JA		 707 (hexl-insert-char num arg))))
708
709(defun hexl-insert-octal-char (arg)
710 "Insert a ASCII char ARG times at point for a given octal number."
711 (interactive "p")
712 (let ((num (hexl-octal-string-to-integer (read-string "Octal Number: "))))
713 (if (or (> num 255) (< num 0))
19e31f7c 714 (error "Decimal number out of range")
a2535589
JA		 715 (hexl-insert-char num arg))))
716
db6c5b92
SE		 717(defun hexl-follow-ascii (&optional arg)
718 "Toggle following ASCII in Hexl buffers.
719With prefix ARG, turn on following if and only if ARG is positive.
720When following is enabled, the ASCII character corresponding to the
721element under the point is highlighted.
722Customize the variable `hexl-follow-ascii' to disable this feature."
723 (interactive "P")
724 (let ((on-p (if arg
725 (> (prefix-numeric-value arg) 0)
726 (not hexl-ascii-overlay))))
727
728 (make-local-hook 'post-command-hook)
729
730 (if on-p
731 ;; turn it on
732 (if (not hexl-ascii-overlay)
733 (progn
734 (setq hexl-ascii-overlay (make-overlay 1 1)
735 hexl-follow-ascii t)
736 (overlay-put hexl-ascii-overlay 'face 'highlight)
737 (add-hook 'post-command-hook 'hexl-follow-ascii-find nil t)))
738 ;; turn it off
739 (if hexl-ascii-overlay
740 (progn
741 (delete-overlay hexl-ascii-overlay)
742 (setq hexl-ascii-overlay nil
743 hexl-follow-ascii nil)
744 (remove-hook 'post-command-hook 'hexl-follow-ascii-find t)
745 )))))
746
747(defun hexl-follow-ascii-find ()
748 "Find and highlight the ASCII element corresponding to current point."
749 (let ((pos (+ 51
750 (- (point) (current-column))
751 (mod (hexl-current-address) 16))))
752 (move-overlay hexl-ascii-overlay pos (1+ pos))
753 ))
754
a2535589
JA		 755;; startup stuff.
756
757(if hexl-mode-map
758 nil
ae2d451b
RS		 759 (setq hexl-mode-map (make-sparse-keymap))
760
761 (define-key hexl-mode-map [left] 'hexl-backward-char)
762 (define-key hexl-mode-map [right] 'hexl-forward-char)
763 (define-key hexl-mode-map [up] 'hexl-previous-line)
764 (define-key hexl-mode-map [down] 'hexl-next-line)
765 (define-key hexl-mode-map [M-left] 'hexl-backward-short)
766 (define-key hexl-mode-map [M-right] 'hexl-forward-short)
767 (define-key hexl-mode-map [next] 'hexl-scroll-up)
768 (define-key hexl-mode-map [prior] 'hexl-scroll-down)
769 (define-key hexl-mode-map [home] 'hexl-beginning-of-buffer)
770 (define-key hexl-mode-map [deletechar] 'undefined)
771 (define-key hexl-mode-map [deleteline] 'undefined)
772 (define-key hexl-mode-map [insertline] 'undefined)
773 (define-key hexl-mode-map [S-delete] 'undefined)
774 (define-key hexl-mode-map "\177" 'undefined)
775
776 (define-key hexl-mode-map "\C-a" 'hexl-beginning-of-line)
777 (define-key hexl-mode-map "\C-b" 'hexl-backward-char)
778 (define-key hexl-mode-map "\C-d" 'undefined)
779 (define-key hexl-mode-map "\C-e" 'hexl-end-of-line)
780 (define-key hexl-mode-map "\C-f" 'hexl-forward-char)
781
782 (if (not (eq (key-binding (char-to-string help-char)) 'help-command))
783 (define-key hexl-mode-map (char-to-string help-char) 'undefined))
784
785 (define-key hexl-mode-map "\C-i" 'hexl-self-insert-command)
786 (define-key hexl-mode-map "\C-j" 'hexl-self-insert-command)
787 (define-key hexl-mode-map "\C-k" 'undefined)
788 (define-key hexl-mode-map "\C-m" 'hexl-self-insert-command)
789 (define-key hexl-mode-map "\C-n" 'hexl-next-line)
790 (define-key hexl-mode-map "\C-o" 'undefined)
791 (define-key hexl-mode-map "\C-p" 'hexl-previous-line)
792 (define-key hexl-mode-map "\C-q" 'hexl-quoted-insert)
793 (define-key hexl-mode-map "\C-t" 'undefined)
794 (define-key hexl-mode-map "\C-v" 'hexl-scroll-up)
795 (define-key hexl-mode-map "\C-w" 'undefined)
796 (define-key hexl-mode-map "\C-y" 'undefined)
797
798 (let ((ch 32))
799 (while (< ch 127)
800 (define-key hexl-mode-map (format "%c" ch) 'hexl-self-insert-command)
801 (setq ch (1+ ch))))
802
803 (define-key hexl-mode-map "\e\C-a" 'hexl-beginning-of-512b-page)
804 (define-key hexl-mode-map "\e\C-b" 'hexl-backward-short)
805 (define-key hexl-mode-map "\e\C-c" 'undefined)
806 (define-key hexl-mode-map "\e\C-d" 'hexl-insert-decimal-char)
807 (define-key hexl-mode-map "\e\C-e" 'hexl-end-of-512b-page)
808 (define-key hexl-mode-map "\e\C-f" 'hexl-forward-short)
809 (define-key hexl-mode-map "\e\C-g" 'undefined)
810 (define-key hexl-mode-map "\e\C-h" 'undefined)
811 (define-key hexl-mode-map "\e\C-i" 'undefined)
812 (define-key hexl-mode-map "\e\C-j" 'undefined)
813 (define-key hexl-mode-map "\e\C-k" 'undefined)
814 (define-key hexl-mode-map "\e\C-l" 'undefined)
815 (define-key hexl-mode-map "\e\C-m" 'undefined)
816 (define-key hexl-mode-map "\e\C-n" 'undefined)
817 (define-key hexl-mode-map "\e\C-o" 'hexl-insert-octal-char)
818 (define-key hexl-mode-map "\e\C-p" 'undefined)
819 (define-key hexl-mode-map "\e\C-q" 'undefined)
820 (define-key hexl-mode-map "\e\C-r" 'undefined)
821 (define-key hexl-mode-map "\e\C-s" 'undefined)
822 (define-key hexl-mode-map "\e\C-t" 'undefined)
823 (define-key hexl-mode-map "\e\C-u" 'undefined)
824
825 (define-key hexl-mode-map "\e\C-w" 'undefined)
826 (define-key hexl-mode-map "\e\C-x" 'hexl-insert-hex-char)
827 (define-key hexl-mode-map "\e\C-y" 'undefined)
828
829 (define-key hexl-mode-map "\ea" 'undefined)
830 (define-key hexl-mode-map "\eb" 'hexl-backward-word)
831 (define-key hexl-mode-map "\ec" 'undefined)
832 (define-key hexl-mode-map "\ed" 'undefined)
833 (define-key hexl-mode-map "\ee" 'undefined)
834 (define-key hexl-mode-map "\ef" 'hexl-forward-word)
835 (define-key hexl-mode-map "\eg" 'hexl-goto-hex-address)
836 (define-key hexl-mode-map "\eh" 'undefined)
837 (define-key hexl-mode-map "\ei" 'undefined)
838 (define-key hexl-mode-map "\ej" 'hexl-goto-address)
839 (define-key hexl-mode-map "\ek" 'undefined)
840 (define-key hexl-mode-map "\el" 'undefined)
841 (define-key hexl-mode-map "\em" 'undefined)
842 (define-key hexl-mode-map "\en" 'undefined)
843 (define-key hexl-mode-map "\eo" 'undefined)
844 (define-key hexl-mode-map "\ep" 'undefined)
845 (define-key hexl-mode-map "\eq" 'undefined)
846 (define-key hexl-mode-map "\er" 'undefined)
847 (define-key hexl-mode-map "\es" 'undefined)
848 (define-key hexl-mode-map "\et" 'undefined)
849 (define-key hexl-mode-map "\eu" 'undefined)
850 (define-key hexl-mode-map "\ev" 'hexl-scroll-down)
851 (define-key hexl-mode-map "\ey" 'undefined)
852 (define-key hexl-mode-map "\ez" 'undefined)
853 (define-key hexl-mode-map "\e<" 'hexl-beginning-of-buffer)
854 (define-key hexl-mode-map "\e>" 'hexl-end-of-buffer)
855
856 (define-key hexl-mode-map "\C-c\C-c" 'hexl-mode-exit)
857
858 (define-key hexl-mode-map "\C-x[" 'hexl-beginning-of-1k-page)
859 (define-key hexl-mode-map "\C-x]" 'hexl-end-of-1k-page)
860 (define-key hexl-mode-map "\C-x\C-p" 'undefined)
861 (define-key hexl-mode-map "\C-x\C-s" 'hexl-save-buffer)
862 (define-key hexl-mode-map "\C-x\C-t" 'undefined))
a2535589 863
19e31f7c
RS		 864(provide 'hexl)
865
1a06eabd 866;;; hexl.el ends here
Unnamed repository; edit this file 'description' to name the repository.