Mercurial > emacs
comparison lisp/hexl.el @ 47968:73b8f2ad9e28
(hexl-mode-old-write-contents-hooks): Remove.
(hexl-mode, hexl-current-address, hexl-address-to-marker)
(hexl-insert-char): Don't hardcode point-min == 1.
(hexl-isearch-search-function): New fun.
(hexl-mode-old-isearch-search-fun-function): New var.
(hexl-mode): Use them.
(hexl-mode, hexl-mode-exit, hexl-maybe-dehexlify-buffer):
Use write-contents-functions rather then write-contents-hooks.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Mon, 21 Oct 2002 22:45:20 +0000 |
parents | cc56a3fad98f |
children | fffd84e47253 |
comparison
equal
deleted
inserted
replaced
47967:0a8bff6f0168 | 47968:73b8f2ad9e28 |
---|---|
82 (defvar hexl-mode-map nil) | 82 (defvar hexl-mode-map nil) |
83 | 83 |
84 (defvar hexl-mode-old-local-map) | 84 (defvar hexl-mode-old-local-map) |
85 (defvar hexl-mode-old-mode-name) | 85 (defvar hexl-mode-old-mode-name) |
86 (defvar hexl-mode-old-major-mode) | 86 (defvar hexl-mode-old-major-mode) |
87 (defvar hexl-mode-old-write-contents-hooks) | 87 (defvar hexl-mode-old-isearch-search-fun-function) |
88 (defvar hexl-mode-old-require-final-newline) | 88 (defvar hexl-mode-old-require-final-newline) |
89 (defvar hexl-mode-old-syntax-table) | 89 (defvar hexl-mode-old-syntax-table) |
90 | 90 |
91 (defvar hexl-ascii-overlay nil | 91 (defvar hexl-ascii-overlay nil |
92 "Overlay used to highlight ASCII element corresponding to current point.") | 92 "Overlay used to highlight ASCII element corresponding to current point.") |
172 \\[describe-bindings] for advanced commands." | 172 \\[describe-bindings] for advanced commands." |
173 (interactive "p") | 173 (interactive "p") |
174 (unless (eq major-mode 'hexl-mode) | 174 (unless (eq major-mode 'hexl-mode) |
175 (let ((modified (buffer-modified-p)) | 175 (let ((modified (buffer-modified-p)) |
176 (inhibit-read-only t) | 176 (inhibit-read-only t) |
177 (original-point (1- (point))) | 177 (original-point (- (point) (point-min))) |
178 max-address) | 178 max-address) |
179 (and (eobp) (not (bobp)) | 179 (and (eobp) (not (bobp)) |
180 (setq original-point (1- original-point))) | 180 (setq original-point (1- original-point))) |
181 (if (not (or (eq arg 1) (not arg))) | 181 (if (not (or (eq arg 1) (not arg))) |
182 ;; if no argument then we guess at hexl-max-address | 182 ;; if no argument then we guess at hexl-max-address |
209 | 209 |
210 (make-local-variable 'hexl-mode-old-mode-name) | 210 (make-local-variable 'hexl-mode-old-mode-name) |
211 (setq hexl-mode-old-mode-name mode-name) | 211 (setq hexl-mode-old-mode-name mode-name) |
212 (setq mode-name "Hexl") | 212 (setq mode-name "Hexl") |
213 | 213 |
214 (set (make-local-variable 'hexl-mode-old-isearch-search-fun-function) | |
215 isearch-search-fun-function) | |
216 (set (make-local-variable 'isearch-search-fun-function) | |
217 'hexl-isearch-search-function) | |
218 | |
214 (make-local-variable 'hexl-mode-old-major-mode) | 219 (make-local-variable 'hexl-mode-old-major-mode) |
215 (setq hexl-mode-old-major-mode major-mode) | 220 (setq hexl-mode-old-major-mode major-mode) |
216 (setq major-mode 'hexl-mode) | 221 (setq major-mode 'hexl-mode) |
217 | 222 |
218 (make-local-variable 'hexl-mode-old-syntax-table) | 223 (make-local-variable 'hexl-mode-old-syntax-table) |
219 (setq hexl-mode-old-syntax-table (syntax-table)) | 224 (setq hexl-mode-old-syntax-table (syntax-table)) |
220 (set-syntax-table (standard-syntax-table)) | 225 (set-syntax-table (standard-syntax-table)) |
221 | 226 |
222 (make-local-variable 'hexl-mode-old-write-contents-hooks) | 227 (add-hook 'write-contents-functions 'hexl-save-buffer nil t) |
223 (setq hexl-mode-old-write-contents-hooks write-contents-hooks) | |
224 (make-local-variable 'write-contents-hooks) | |
225 (add-hook 'write-contents-hooks 'hexl-save-buffer) | |
226 | 228 |
227 (make-local-variable 'hexl-mode-old-require-final-newline) | 229 (make-local-variable 'hexl-mode-old-require-final-newline) |
228 (setq hexl-mode-old-require-final-newline require-final-newline) | 230 (setq hexl-mode-old-require-final-newline require-final-newline) |
229 (make-local-variable 'require-final-newline) | 231 (make-local-variable 'require-final-newline) |
230 (setq require-final-newline nil) | 232 (setq require-final-newline nil) |
234 | 236 |
235 (add-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer nil t) | 237 (add-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer nil t) |
236 | 238 |
237 (if hexl-follow-ascii (hexl-follow-ascii 1))) | 239 (if hexl-follow-ascii (hexl-follow-ascii 1))) |
238 (run-hooks 'hexl-mode-hook)) | 240 (run-hooks 'hexl-mode-hook)) |
241 | |
242 | |
243 (defun hexl-isearch-search-function () | |
244 (if (and (not isearch-regexp) (not isearch-word)) | |
245 (lambda (string &optional bound noerror count) | |
246 (funcall | |
247 (if isearch-forward 're-search-forward 're-search-backward) | |
248 (if (> (length string) 80) | |
249 (regexp-quote string) | |
250 (mapconcat 'string string "\\(?:\n\\(?:[:a-f0-9]+ \\)+ \\)?")) | |
251 bound noerror count)) | |
252 (let ((isearch-search-fun-function nil)) | |
253 (isearch-search-fun)))) | |
239 | 254 |
240 (defun hexl-after-revert-hook () | 255 (defun hexl-after-revert-hook () |
241 (setq hexl-max-address (1- (buffer-size))) | 256 (setq hexl-max-address (1- (buffer-size))) |
242 (hexlify-buffer) | 257 (hexlify-buffer) |
243 (set-buffer-modified-p nil)) | 258 (set-buffer-modified-p nil)) |
292 (if (or (eq arg 1) (not arg)) | 307 (if (or (eq arg 1) (not arg)) |
293 (let ((modified (buffer-modified-p)) | 308 (let ((modified (buffer-modified-p)) |
294 (inhibit-read-only t) | 309 (inhibit-read-only t) |
295 (original-point (1+ (hexl-current-address)))) | 310 (original-point (1+ (hexl-current-address)))) |
296 (dehexlify-buffer) | 311 (dehexlify-buffer) |
297 (remove-hook 'write-contents-hooks 'hexl-save-buffer) | 312 (remove-hook 'write-contents-functions 'hexl-save-buffer t) |
298 (set-buffer-modified-p modified) | 313 (set-buffer-modified-p modified) |
299 (goto-char original-point) | 314 (goto-char original-point) |
300 ;; Maybe adjust point for the removed CR characters. | 315 ;; Maybe adjust point for the removed CR characters. |
301 (when (eq (coding-system-eol-type buffer-file-coding-system) 1) | 316 (when (eq (coding-system-eol-type buffer-file-coding-system) 1) |
302 (setq original-point (- original-point | 317 (setq original-point (- original-point |
307 (remove-hook 'after-revert-hook 'hexl-after-revert-hook t) | 322 (remove-hook 'after-revert-hook 'hexl-after-revert-hook t) |
308 (remove-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer t) | 323 (remove-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer t) |
309 (remove-hook 'post-command-hook 'hexl-follow-ascii-find t) | 324 (remove-hook 'post-command-hook 'hexl-follow-ascii-find t) |
310 (setq hexl-ascii-overlay nil) | 325 (setq hexl-ascii-overlay nil) |
311 | 326 |
312 (setq write-contents-hooks hexl-mode-old-write-contents-hooks) | |
313 (setq require-final-newline hexl-mode-old-require-final-newline) | 327 (setq require-final-newline hexl-mode-old-require-final-newline) |
314 (setq mode-name hexl-mode-old-mode-name) | 328 (setq mode-name hexl-mode-old-mode-name) |
329 (setq isearch-search-fun-function hexl-mode-old-isearch-search-fun-function) | |
315 (use-local-map hexl-mode-old-local-map) | 330 (use-local-map hexl-mode-old-local-map) |
316 (set-syntax-table hexl-mode-old-syntax-table) | 331 (set-syntax-table hexl-mode-old-syntax-table) |
317 (setq major-mode hexl-mode-old-major-mode) | 332 (setq major-mode hexl-mode-old-major-mode) |
318 (force-mode-line-update)) | 333 (force-mode-line-update)) |
319 | 334 |
323 (if (y-or-n-p "Convert contents back to binary format? ") | 338 (if (y-or-n-p "Convert contents back to binary format? ") |
324 (let ((modified (buffer-modified-p)) | 339 (let ((modified (buffer-modified-p)) |
325 (inhibit-read-only t) | 340 (inhibit-read-only t) |
326 (original-point (1+ (hexl-current-address)))) | 341 (original-point (1+ (hexl-current-address)))) |
327 (dehexlify-buffer) | 342 (dehexlify-buffer) |
328 (remove-hook 'write-contents-hooks 'hexl-save-buffer) | 343 (remove-hook 'write-contents-functions 'hexl-save-buffer t) |
329 (set-buffer-modified-p modified) | 344 (set-buffer-modified-p modified) |
330 (goto-char original-point)))) | 345 (goto-char original-point)))) |
331 | 346 |
332 (defun hexl-current-address (&optional validate) | 347 (defun hexl-current-address (&optional validate) |
333 "Return current hexl-address." | 348 "Return current hexl-address." |
334 (interactive) | 349 (interactive) |
335 (let ((current-column (- (% (point) 68) 11)) | 350 (let ((current-column (- (% (- (point) (point-min) -1) 68) 11)) |
336 (hexl-address 0)) | 351 (hexl-address 0)) |
337 (if (< current-column 0) | 352 (if (< current-column 0) |
338 (if validate | 353 (if validate |
339 (error "Point is not on a character in the file") | 354 (error "Point is not on a character in the file") |
340 (setq current-column 0))) | 355 (setq current-column 0))) |
341 (setq hexl-address | 356 (setq hexl-address |
342 (+ (* (/ (point) 68) 16) | 357 (+ (* (/ (- (point) (point-min) -1) 68) 16) |
343 (if (>= current-column 41) | 358 (if (>= current-column 41) |
344 (- current-column 41) | 359 (- current-column 41) |
345 (/ (- current-column (/ current-column 5)) 2)))) | 360 (/ (- current-column (/ current-column 5)) 2)))) |
346 (when (interactive-p) | 361 (when (interactive-p) |
347 (message "Current address is %d" hexl-address)) | 362 (message "Current address is %d" hexl-address)) |
348 hexl-address)) | 363 hexl-address)) |
349 | 364 |
350 (defun hexl-address-to-marker (address) | 365 (defun hexl-address-to-marker (address) |
351 "Return buffer position for ADDRESS." | 366 "Return buffer position for ADDRESS." |
352 (interactive "nAddress: ") | 367 (interactive "nAddress: ") |
353 (+ (* (/ address 16) 68) 11 (/ (* (% address 16) 5) 2))) | 368 (+ (* (/ address 16) 68) 10 (point-min) (/ (* (% address 16) 5) 2))) |
354 | 369 |
355 (defun hexl-goto-address (address) | 370 (defun hexl-goto-address (address) |
356 "Goto hexl-mode (decimal) address ADDRESS. | 371 "Goto hexl-mode (decimal) address ADDRESS. |
357 Signal error if ADDRESS out of range." | 372 Signal error if ADDRESS out of range." |
358 (interactive "nAddress: ") | 373 (interactive "nAddress: ") |
728 (error "Invalid character 0x%x -- must be in the range [0..255]")) | 743 (error "Invalid character 0x%x -- must be in the range [0..255]")) |
729 (let ((address (hexl-current-address t))) | 744 (let ((address (hexl-current-address t))) |
730 (while (> num 0) | 745 (while (> num 0) |
731 (let ((hex-position | 746 (let ((hex-position |
732 (+ (* (/ address 16) 68) | 747 (+ (* (/ address 16) 68) |
733 11 | 748 10 (point-min) |
734 (* 2 (% address 16)) | 749 (* 2 (% address 16)) |
735 (/ (% address 16) 2))) | 750 (/ (% address 16) 2))) |
736 (ascii-position | 751 (ascii-position |
737 (+ (* (/ address 16) 68) 52 (% address 16))) | 752 (+ (* (/ address 16) 68) 51 (point-min) (% address 16))) |
738 at-ascii-position) | 753 at-ascii-position) |
739 (if (= (point) ascii-position) | 754 (if (= (point) ascii-position) |
740 (setq at-ascii-position t)) | 755 (setq at-ascii-position t)) |
741 (goto-char hex-position) | 756 (goto-char hex-position) |
742 (delete-char 2) | 757 (delete-char 2) |