nhexl-mode.el (56159B)
1 ;;; nhexl-mode.el --- Minor mode to edit files via hex-dump format -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2010-2020 Free Software Foundation, Inc. 4 5 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> 6 ;; Keywords: data 7 ;; Version: 1.5 8 ;; Package-Requires: ((emacs "24.4") (cl-lib "0.5")) 9 10 ;; This program is free software; you can redistribute it and/or modify 11 ;; it under the terms of the GNU General Public License as published by 12 ;; the Free Software Foundation, either version 3 of the License, or 13 ;; (at your option) any later version. 14 15 ;; This program is distributed in the hope that it will be useful, 16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 ;; GNU General Public License for more details. 19 20 ;; You should have received a copy of the GNU General Public License 21 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 22 23 ;;; Commentary: 24 25 ;; This package implements NHexl mode, a minor mode for editing files 26 ;; in hex dump format. The mode command is called `nhexl-mode'. 27 ;; 28 ;; This minor mode implements similar functionality to `hexl-mode', 29 ;; but using a different implementation technique, which makes it 30 ;; usable as a "plain" minor mode. It works on any buffer, and does 31 ;; not mess with the undo log or with the major mode. 32 ;; 33 ;; It also comes with: 34 ;; 35 ;; - `nhexl-nibble-edit-mode': a "nibble editor" minor mode. 36 ;; where the cursor pretends to advance by nibbles (4-bit) and the 37 ;; self-insertion keys let you edit the hex digits directly. 38 ;; 39 ;; - `nhexl-overwrite-only-mode': a minor mode to try and avoid moving text. 40 ;; In this minor mode, not only self-inserting keys overwrite existing 41 ;; text, but commands like `yank' and `kill-region' as well. 42 ;; 43 ;; - it overrides C-u to use hexadecimal, so you can do C-u a 4 C-f 44 ;; to advance by #xa4 characters. 45 46 ;; Even though the hex addresses and hex data displayed by this mode aren't 47 ;; actually part of the buffer's text (contrary to hexl-mode, for example, 48 ;; they're only added to the display), you can search them with Isearch, 49 ;; according to nhexl-isearch-hex-addresses and nhexl-isearch-hex-bytes. 50 51 ;;;; Known bugs: 52 ;; 53 ;; - When the buffer is displayed in several windows, the "cursor" in the hex 54 ;; area only reflects one of the window-points. Fixing this would be rather 55 ;; painful: 56 ;; - for every cursor, we need an extra overlay with the `window' 57 ;; property with its own `before-string'. 58 ;; - because that overlay won't *replace* the normal overlay (the one 59 ;; without the `window' property), we will need to *remove* that 60 ;; overlay (lest we get 2 before-strings) and replace it with N overlays 61 ;; with a `window' property (for all N other windows that don't have 62 ;; their cursor on this line). 63 ;; FWIW, the original `hexl-mode' has the same kind of problem. 64 65 ;;;; Wishlist: 66 67 ;; - An equivalent to hexl-mode's `hexl-bits'. 68 ;; - Always reload the file with find-file-literally instead 69 ;; of editing the multibyte representation? 70 71 ;;; Code: 72 73 (eval-when-compile (require 'cl-lib)) 74 (require 'hexl) ;For faces. 75 76 (defgroup nhexl nil 77 "Edit a file in a hex dump format." 78 :group 'data) 79 80 (defcustom nhexl-line-width 16 81 "Number of bytes per line." 82 :type '(choice (integer :tag "Fixed width") (const :tag "Adjust to window" t))) 83 84 (defcustom nhexl-display-unprintables nil 85 "If non-nil, display non-printable chars using the customary codes. 86 If nil, use just `.' for those chars instead of things like `\\NNN' or `^C'." 87 :type 'boolean) 88 89 (defcustom nhexl-obey-font-lock t 90 "If non-nil, faces will only be applied when font-lock is enabled. 91 Otherwise they are applied unconditionally." 92 :type 'boolean) 93 94 (defcustom nhexl-silently-convert-to-unibyte nil 95 "If non-nil `nhexl-mode' won't ask before converting the buffer to unibyte." 96 :type 'boolean) 97 98 (defcustom nhexl-isearch-hex-addresses t 99 "If non-nil, hex search terms will look for matching addresses." 100 :type 'boolean) 101 102 (defcustom nhexl-isearch-hex-bytes t 103 "If non-nil, hex search terms will look for matching bytes." 104 :type 'boolean) 105 106 (defcustom nhexl-isearch-hex-highlight t 107 "If non-nil, nhexl will highlight Isearch matches in the hex areas as well." 108 :type 'boolean) 109 110 (defcustom nhexl-group-size (max 1 (/ hexl-bits 8)) 111 "Number of bytes in each group. 112 Groups are separated by spaces." 113 :type 'integer) 114 115 (defcustom nhexl-separate-line nil 116 ;; FIXME: This var is not taken into account when auto-sizing the 117 ;; line-width! 118 "If non-nil, put the ascii area below the hex, on a separate line." 119 :type 'boolean) 120 121 (defvar nhexl--display-table 122 (let ((dt (make-display-table))) 123 (unless nhexl-display-unprintables 124 (dotimes (i 128) 125 (when (> (char-width i) 1) 126 (setf (aref dt i) [?.]))) 127 (dotimes (i 128) 128 (setf (aref dt (unibyte-char-to-multibyte (+ i 128))) [?.]))) 129 ;; (aset dt ?\n [?␊]) 130 (aset dt ?\t [?␉]) 131 dt)) 132 133 (defvar-local nhexl--saved-vars nil) 134 135 ;;;; Nibble editing minor mode 136 137 ;; FIXME: Region highlighting in this minor mode should highlight the hex area 138 ;; rather than only the ascii area! 139 ;; FIXME: Kill&yank in this minor mode should work on the hex representation 140 ;; of the buffer's content (and should obey overwrite-mode)! 141 142 (defvar nhexl-nibble-edit-mode-map 143 (let ((map (make-sparse-keymap))) 144 (define-key map [remap self-insert-command] #'nhexl-nibble-self-insert) 145 (define-key map [remap right-char] #'nhexl-nibble-forward) 146 (define-key map [remap forward-char] #'nhexl-nibble-forward) 147 (define-key map [remap left-char] #'nhexl-nibble-backward) 148 (define-key map [remap backward-char] #'nhexl-nibble-backward) 149 map)) 150 151 ;; FIXME: Reuben Thomas pointed out that the user may not think of it as 152 ;; "editing nibbles" but "editing the hex codes" instead. 153 ;; Maybe we should rename `nhexl-nibble-edit-mode'? 154 (defalias 'nhexl-hex-edit-mode #'nhexl-nibble-edit-mode) 155 (define-minor-mode nhexl-nibble-edit-mode 156 "Minor mode to edit the hex nibbles in `nhexl-mode'." 157 :global nil 158 (if nhexl-nibble-edit-mode 159 (setq-local cursor-type 'hbar) 160 (kill-local-variable 'cursor-type)) 161 (nhexl--refresh-cursor)) 162 163 (defvar-local nhexl--nibbles nil 164 "Nibble state of the various `point's. 165 List of elements of the form (WINDOW OFFSET POINT TICKS), 166 where WINDOW can be nil (for the `point' of the buffer itself); 167 OFFSET is the nibble-position within the byte at POINT (0 = leftmost); 168 and TICKS is the `buffer-chars-modified-tick' for which this was valid.") 169 170 (defun nhexl--nibble (&optional pos) 171 (let ((cwin (if (eq (current-buffer) (window-buffer)) (selected-window))) 172 (data ())) 173 (dolist (n nhexl--nibbles) 174 (let ((nwin (car n))) 175 (cond 176 ((eq cwin nwin) (setq data n)) 177 ((eq (current-buffer) (window-buffer nwin)) nil) 178 (t (setq nhexl--nibbles (delq n nhexl--nibbles)))))) 179 (or (and (eq (or pos (point)) (nth 2 data)) 180 (eq (buffer-chars-modified-tick) (nth 3 data)) 181 (nth 1 data)) 182 (progn 183 (setq nhexl--nibbles (delq data nhexl--nibbles)) 184 0)))) 185 186 (defun nhexl--nibble-set (n) 187 (let* ((cwin (if (eq (current-buffer) (window-buffer)) (selected-window))) 188 (data (assq cwin nhexl--nibbles))) 189 (unless data 190 (push (setq data (list cwin)) nhexl--nibbles)) 191 (setcdr data (list n (point) (buffer-chars-modified-tick))))) 192 193 (defsubst nhexl--line-width () 194 (if (integerp nhexl-line-width) nhexl-line-width 16)) 195 196 (defun nhexl--nibble-max (&optional char) 197 (unless char (setq char (following-char))) 198 (if (< char 256) 1 199 (let ((i 1)) 200 (setq char (/ char 256)) 201 (while (> char 0) 202 (setq char (/ char 16)) 203 (setq i (1+ i))) 204 i))) 205 206 (defun nhexl-nibble-forward () 207 "Advance by one nibble." 208 (interactive) 209 (let ((nib (nhexl--nibble))) 210 (if (>= nib (nhexl--nibble-max)) 211 (forward-char 1) 212 (nhexl--nibble-set (1+ nib)) 213 (nhexl--refresh-cursor)))) 214 215 (defun nhexl-nibble-backward () 216 "Advance by one nibble." 217 (interactive) 218 (let ((nib (nhexl--nibble))) 219 (if (> nib 0) 220 (progn 221 (nhexl--nibble-set (1- nib)) 222 (nhexl--refresh-cursor)) 223 (backward-char 1) 224 (nhexl--nibble-set (nhexl--nibble-max))))) 225 226 (defun nhexl-nibble-self-insert () 227 "Overwrite current nibble with the hex character you type." 228 (interactive) 229 (let* ((max (nhexl--nibble-max)) 230 (nib (min max (nhexl--nibble))) 231 (char (if (and (not overwrite-mode) (= nib 0)) 0 (following-char))) 232 (hex (format "%02x" char)) 233 (nhex (concat (substring hex 0 nib) 234 (string last-command-event) 235 (substring hex (1+ nib)))) 236 (nchar (string-to-number nhex 16))) 237 (insert nchar) 238 (unless (or (eobp) 239 (and (not overwrite-mode) (= nib 0))) 240 (delete-char 1)) 241 (if (= max nib) nil 242 (backward-char 1) 243 (nhexl--nibble-set (1+ nib))))) 244 245 ;;;; No insertion/deletion minor mode 246 247 ;; FIXME: To make it work more generally, we should hook into 248 ;; after-change-function, but we can't work directly from there because 249 ;; it's called at too fine a grain (an overwrite is actually an 250 ;; insertion+deletion and will run after-change-function, twice). 251 252 (defvar nhexl-overwrite-clear-byte ?\000 253 "Byte to use to replace deleted content.") 254 255 (defvar nhexl-overwrite-only-mode-map 256 (let ((map (make-sparse-keymap))) 257 (define-key map [remap yank] #'nhexl-overwrite-yank) 258 (define-key map [remap yank-pop] #'nhexl-overwrite-yank-pop) 259 (define-key map [remap kill-region] #'nhexl-overwrite-kill-region) 260 (define-key map [remap delete-char] #'nhexl-overwrite-delete-char) 261 (define-key map [remap backward-delete-char-untabify] 262 #'nhexl-overwrite-backward-delete-char) 263 (define-key map [remap backward-delete-char] 264 #'nhexl-overwrite-backward-delete-char) 265 map)) 266 267 (defun nhexl-overwrite-backward-delete-char (&optional arg) 268 "Delete ARG chars backward by overwriting them. 269 Uses `nhexl-overwrite-clear-byte'." 270 (interactive "p") 271 (unless arg (setq arg 1)) 272 (if (< arg 0) 273 (nhexl-overwrite-delete-char (- arg)) 274 (forward-char (- arg)) 275 (save-excursion 276 (insert-char nhexl-overwrite-clear-byte arg) 277 (delete-char arg)))) 278 279 (defun nhexl-overwrite-delete-char (&optional arg) 280 "Delete ARG chars forward by overwriting them. 281 Uses `nhexl-overwrite-clear-byte'." 282 (interactive "p") 283 (unless arg (setq arg 1)) 284 (if (< arg 0) 285 (nhexl-overwrite-backward-delete-char (- arg)) 286 (insert-char nhexl-overwrite-clear-byte arg) 287 (delete-char arg))) 288 289 (defun nhexl-overwrite-kill-region (beg end &optional region) 290 "Kill the region, replacing it with `nhexl-overwrite-clear-byte'." 291 (interactive (list (mark) (point) 'region)) 292 (copy-region-as-kill beg end region) 293 (barf-if-buffer-read-only) 294 (pcase-dolist (`(,beg . ,end) 295 (if region (funcall region-extract-function 'bounds) 296 (list beg end))) 297 (goto-char beg) 298 (nhexl-overwrite-delete-char (- end beg)))) 299 300 (defun nhexl-overwrite--yank-wrapper (fun) 301 ;; FIXME? doesn't work when yanking things like rectangles. 302 (let ((orig-size (buffer-size))) 303 (funcall fun) 304 (let* ((inserted (- (buffer-size) orig-size)) 305 (deleted (delete-and-extract-region 306 (point) 307 (min (point-max) (+ (point) inserted))))) 308 (unless yank-undo-function 309 (setq yank-undo-function #'delete-region)) 310 (add-function :before yank-undo-function 311 (lambda (_beg end) 312 (save-excursion 313 (goto-char end) 314 (insert deleted))))))) 315 316 (defun nhexl-overwrite-yank (&optional arg) 317 "Like `yank' but overwriting existing text." 318 (interactive "*P") 319 (nhexl-overwrite--yank-wrapper (lambda () (yank arg)))) 320 321 (defun nhexl-overwrite-yank-pop (&optional arg) 322 "Like `yank-pop' but overwriting existing text." 323 (interactive "*P") 324 (nhexl-overwrite--yank-wrapper (lambda () (yank-pop arg)))) 325 326 (defvar-local nhexl--overwrite-save-settings nil) 327 328 (define-minor-mode nhexl-overwrite-only-mode 329 "Minor mode where text is only overwritten. 330 Insertion/deletion is avoided where possible and replaced by overwriting 331 existing text, if needed with `nhexl-overwrite-clear-byte'." 332 :lighter nil 333 (cond 334 (nhexl-overwrite-only-mode 335 (push (cons 'overwrite-mode overwrite-mode) 336 nhexl--overwrite-save-settings) 337 (setq-local overwrite-mode 'overwrite-mode-binary) 338 (setq-local overwrite-mode-binary " OnlyOvwrt")) 339 (t 340 (pcase-dolist (`(,var . ,val) 341 (prog1 nhexl--overwrite-save-settings 342 (setq nhexl--overwrite-save-settings nil))) 343 (set var val)) 344 (kill-local-variable 'overwrite-mode-binary)))) 345 346 ;;;; Main minor mode 347 348 (defvar nhexl-mode-map 349 (let ((map (make-sparse-keymap))) 350 ;; `next-line' and `previous-line' work correctly, but they take ages in 351 ;; large buffers and allocate an insane amount of memory, so the GC is 352 ;; constantly triggered. 353 ;; So instead we just override them with our own custom-tailored functions 354 ;; which don't have to work nearly as hard to figure out where's the 355 ;; next line. 356 ;; FIXME: It would also be good to try and improve `next-line' and 357 ;; `previous-line' for this case, tho it is pretty pathological for them. 358 (define-key map [remap next-line] #'nhexl-next-line) 359 (define-key map [remap previous-line] #'nhexl-previous-line) 360 (define-key map [remap move-end-of-line] #'nhexl-move-end-of-line) 361 (define-key map [remap move-beginning-of-line] 362 #'nhexl-move-beginning-of-line) 363 ;; Just as for line movement, scrolling movement could/should work as-is 364 ;; but benefit from an ad-hoc implementation. 365 (define-key map [remap scroll-up-command] #'nhexl-scroll-up) 366 (define-key map [remap scroll-down-command] #'nhexl-scroll-down) 367 (define-key map [remap mouse-set-point] #'nhexl-mouse-set-point) 368 (define-key map [remap mouse-drag-region] #'nhexl-mouse-drag-region) 369 (define-key map [remap mouse-set-region] #'nhexl-mouse-set-region) 370 ;; FIXME: Should we really make it hard to use non-binary `overwrite-mode'? 371 ;; Or should we go even further and remap it to 372 ;; `nhexl-overwrite-only-mode'? 373 (define-key map [remap overwrite-mode] #'binary-overwrite-mode) 374 ;; FIXME: Find a key binding for nhexl-nibble-edit-mode! 375 map)) 376 377 (defvar-local nhexl--point nil) 378 379 ;;;###autoload 380 (define-minor-mode nhexl-mode 381 "Minor mode to edit files via hex-dump format" 382 :lighter (" NHexl" (nhexl-nibble-edit-mode "/ne")) 383 (dolist (varl (prog1 nhexl--saved-vars 384 (kill-local-variable 'nhexl--saved-vars))) 385 (set (make-local-variable (car varl)) (cdr varl))) 386 387 (if (not nhexl-mode) 388 (progn 389 (jit-lock-unregister #'nhexl--jit) 390 (remove-hook 'after-change-functions #'nhexl--change-function 'local) 391 (remove-hook 'post-command-hook #'nhexl--post-command 'local) 392 (if (>= emacs-major-version 27) 393 (remove-hook 'window-size-change-functions #'nhexl--window-size-change t) 394 (remove-hook 'window-configuration-change-hook 395 #'nhexl--window-config-change t) 396 (remove-hook 'window-size-change-functions #'nhexl--window-size-change)) 397 (remove-function (local 'isearch-search-fun-function) 398 #'nhexl--isearch-search-fun) 399 ;; FIXME: This conflicts with any other use of `display'. 400 (with-silent-modifications 401 (put-text-property (point-min) (point-max) 'display nil)) 402 (remove-overlays (point-min) (point-max) 'nhexl t)) 403 404 (when (and enable-multibyte-characters 405 ;; No point changing to unibyte in a pure-ASCII buffer. 406 (not (= (position-bytes (point-max)) (point-max))) 407 (not (save-excursion 408 (save-restriction 409 (widen) 410 (goto-char (point-min)) 411 (re-search-forward "[^[:ascii:]\200-\377]" nil t)))) 412 ;; We're in a multibyte buffer which only contains bytes, 413 ;; so we could advantageously convert it to unibyte. 414 (or nhexl-silently-convert-to-unibyte 415 (y-or-n-p "Make buffer unibyte? "))) 416 (set-buffer-multibyte nil)) 417 418 (unless (local-variable-p 'nhexl--saved-vars) 419 (dolist (var '(buffer-display-table buffer-invisibility-spec 420 overwrite-mode header-line-format word-wrap)) 421 (push (cons var (symbol-value var)) nhexl--saved-vars))) 422 (setq nhexl--point (point)) 423 ;; Word-wrap doesn't make much sense together with nhexl-mode and 424 ;; the display-engine tends to suffer unduly if it's enabled. 425 (setq-local word-wrap nil) 426 (setq-local header-line-format '(:eval (nhexl--header-line))) 427 (binary-overwrite-mode 1) 428 (setq-local buffer-invisibility-spec ()) 429 (setq-local buffer-display-table nhexl--display-table) 430 (jit-lock-register #'nhexl--jit) 431 (add-hook 'change-major-mode-hook (lambda () (nhexl-mode -1)) nil 'local) 432 (add-hook 'post-command-hook #'nhexl--post-command nil 'local) 433 (add-hook 'after-change-functions #'nhexl--change-function nil 'local) 434 (if (>= emacs-major-version 27) 435 (add-hook 'window-size-change-functions #'nhexl--window-size-change nil t) 436 (add-hook 'window-configuration-change-hook 437 #'nhexl--window-config-change nil 'local) 438 (add-hook 'window-size-change-functions #'nhexl--window-size-change)) 439 (add-function :around (local 'isearch-search-fun-function) 440 #'nhexl--isearch-search-fun) 441 ;; FIXME: We should delay this to after running the minor-mode hook. 442 (when (and (eq t (default-value 'nhexl-line-width)) 443 (eq (current-buffer) (window-buffer))) 444 (nhexl--adjust-to-width)))) 445 446 (defun nhexl-next-line (&optional arg) 447 "Move cursor vertically down ARG lines." 448 (interactive "p") 449 (unless arg (setq arg 1)) 450 (if (< arg 0) 451 (nhexl-previous-line (- arg)) 452 (let ((nib (nhexl--nibble))) 453 (forward-char (* arg (nhexl--line-width))) 454 (nhexl--nibble-set nib)))) 455 456 (defun nhexl-previous-line (&optional arg) 457 "Move cursor vertically up ARG lines." 458 (interactive "p") 459 (unless arg (setq arg 1)) 460 (if (< arg 0) 461 (nhexl-next-line (- arg)) 462 (let ((nib (nhexl--nibble))) 463 (backward-char (* arg (nhexl--line-width))) 464 (nhexl--nibble-set nib)))) 465 466 (defun nhexl-move-beginning-of-line (&optional arg) 467 "Move to beginning of the hex line that lies ARG - 1 hex lines ahead." 468 (interactive "p") 469 (unless arg (setq arg 1)) 470 (nhexl-next-line (- arg 1)) 471 (backward-char (mod (- (point) 1) nhexl-line-width))) 472 473 (defun nhexl-move-end-of-line (&optional arg) 474 "Move to end of the hex line that lies ARG - 1 hex lines ahead." 475 (interactive "p") 476 (unless arg (setq arg 1)) 477 (nhexl-next-line (- arg 1)) 478 (forward-char (- nhexl-line-width 1 (mod (- (point) 1) nhexl-line-width)))) 479 480 (defun nhexl-scroll-down (&optional arg) 481 "Scroll text of selected window down ARG lines; or near full screen if no ARG." 482 (interactive "P") 483 (unless arg 484 ;; Magic extra 2 lines: 1 line to account for the header-line, and a second 485 ;; to account for the extra empty line that somehow ends up being there 486 ;; pretty much all the time right below the header-line :-( 487 (setq arg (max 1 (- (window-text-height) next-screen-context-lines 2)))) 488 (cond 489 ((< arg 0) (nhexl-scroll-up (- arg))) 490 ((eq arg '-) (nhexl-scroll-up nil)) 491 ((bobp) (scroll-down arg)) ; signal error 492 (t 493 (let* ((ws (window-start)) 494 (nws (- ws (* (nhexl--line-width) arg)))) 495 (if (eq ws (point-min)) 496 (if scroll-error-top-bottom 497 (nhexl-previous-line arg) 498 (scroll-down arg)) 499 (nhexl-previous-line arg) 500 (set-window-start nil (max (point-min) nws))))))) 501 502 (defun nhexl-scroll-up (&optional arg) 503 "Scroll text of selected window up ARG lines; or near full screen if no ARG." 504 (interactive "P") 505 (unless arg 506 ;; Magic extra 2 lines: 1 line to account for the header-line, and a second 507 ;; to account for the extra empty line that somehow ends up being there 508 ;; pretty much all the time right below the header-line :-( 509 (setq arg (max 1 (- (window-text-height) next-screen-context-lines 2)))) 510 (cond 511 ((< arg 0) (nhexl-scroll-down (- arg))) 512 ((eq arg '-) (nhexl-scroll-down nil)) 513 ((eobp) (scroll-up arg)) ; signal error 514 (t 515 (let* ((ws (window-start)) 516 (nws (+ ws (* (nhexl--line-width) arg)))) 517 (if (pos-visible-in-window-p (point-max)) 518 (if scroll-error-top-bottom 519 (nhexl-next-line arg) 520 (scroll-up arg)) 521 (nhexl-next-line arg) 522 (set-window-start nil (min (point-max) nws))))))) 523 524 ;; If we put the LFs in the before-string, we get a spurious empty 525 ;; line at the top of the window (bug#31276), so we put the LFs 526 ;; via a `display' property by default, but it's a bit complicated. 527 (eval-and-compile 528 (defvar nhexl--put-LF-in-string nil)) 529 530 (defun nhexl--posn-hexadjust (posn) 531 "Adjust POSN when clicking on the hex area. 532 Return the corresponding nibble, if applicable." 533 ;; When clicking in the hex area, (nth 1 posn) contains the first position 534 ;; covered by the before-string, and (nth 5 posn) as well. Improve this by 535 ;; setting nth-5 (the one used by `posn-point') to the closest buffer 536 ;; position corresponding to the hex on which we clicked. 537 (let* ((str-data (posn-string posn)) 538 (base-pos (nth 1 posn)) 539 (addr-offset (eval-when-compile 540 (+ (if nhexl--put-LF-in-string 1 0) 541 9 ;for "<address>:" 542 1)))) ;for the following (stretch)space 543 ;; (message "NMSP: strdata=%S" str-data) 544 (when (and (consp str-data) (stringp (car str-data)) (integerp base-pos) 545 (integerp (cdr str-data)) (> (cdr str-data) addr-offset)) 546 (let* ((hexchars (- (cdr str-data) addr-offset)) 547 ;; FIXME: Calculations here go wrong in the presence of 548 ;; chars with code > 255. 549 (hex-no-spaces (- hexchars (/ (1+ hexchars) 5))) 550 (bytes (min (/ hex-no-spaces 2) 551 ;; Bound, for clicks between the hex and ascii areas. 552 (1- (nhexl--line-width)))) 553 (newpos (min (+ base-pos bytes) (point-max)))) 554 (setf (nth 5 posn) newpos) 555 (let* ((nibble (- hex-no-spaces (* bytes 2)))) 556 (min nibble 1)))))) 557 558 (defun nhexl-mouse-set-point (event) 559 "Move point to the position clicked on with the mouse." 560 (interactive "e") 561 (let* ((nibble (nhexl--posn-hexadjust (event-end event)))) 562 (call-interactively #'mouse-set-point) 563 (when (and nibble nhexl-nibble-edit-mode) 564 (nhexl--nibble-set nibble) 565 (nhexl--refresh-cursor)))) 566 567 (defun nhexl-mouse-drag-region (event) 568 "Set the region to the text that the mouse is dragged over." 569 (interactive "e") 570 (nhexl--posn-hexadjust (event-start event)) 571 (call-interactively #'mouse-drag-region)) 572 573 (defun nhexl-mouse-set-region (event) 574 "Set the region to the text dragged over, and copy to kill ring." 575 (interactive "e") 576 (nhexl--posn-hexadjust (event-start event)) 577 (nhexl--posn-hexadjust (event-end event)) 578 (call-interactively #'mouse-set-region)) 579 580 (defun nhexl--change-function (beg end len) 581 ;; Round modifications up-to the hexl-line length since nhexl--jit will need 582 ;; to modify the overlay that covers that text. 583 (let* ((zero (save-restriction (widen) (point-min))) 584 (lw (nhexl--line-width)) 585 (from (max (point-min) 586 (+ zero (* (truncate (- beg zero) lw) lw)))) 587 (to (min (point-max) 588 (+ zero (* (ceiling (- end zero) lw) 589 lw))))) 590 (with-silent-modifications ;Don't store this change in buffer-undo-list! 591 (put-text-property from to 'fontified nil))) 592 ;; Also make sure the tail's addresses are refreshed when 593 ;; text is inserted/removed. 594 (when (/= len (- end beg)) 595 (with-silent-modifications ;Don't store this change in buffer-undo-list! 596 (put-text-property beg (point-max) 'fontified nil)))) 597 598 (defun nhexl--flush () 599 (save-restriction 600 (widen) 601 (nhexl--change-function (point-min) (point-max) (buffer-size)))) 602 603 (defvar nhexl--overlay-counter 1000) 604 (make-variable-buffer-local 'nhexl--overlay-counter) 605 606 (defun nhexl--debug-count-ols () 607 (let ((i 0)) 608 (dolist (ol (overlays-in (point-min) (point-max))) 609 (when (overlay-get ol 'nhexl) (cl-incf i))) 610 i)) 611 612 (defun nhexl--flush-overlays (buffer) 613 (with-current-buffer buffer 614 (kill-local-variable 'nhexl--overlay-counter) 615 ;; We've created many overlays in this buffer, which can slow 616 ;; down operations significantly. Let's flush them. 617 ;; An easy way to flush them is 618 ;; (remove-overlays min max 'nhexl t) 619 ;; (put-text-property min max 'fontified nil) 620 ;; but if the visible part of the buffer requires more than 621 ;; nhexl--overlay-counter overlays, then we'll inf-loop. 622 ;; So let's be more careful about removing overlays. 623 (let ((windows (get-buffer-window-list nil nil t)) 624 (lw (nhexl--line-width)) 625 (start (point-min)) 626 (zero (save-restriction (widen) (point-min))) 627 (debug-count (nhexl--debug-count-ols))) 628 (with-silent-modifications 629 (while (< start (point-max)) 630 (let ((end (point-max))) 631 (dolist (window windows) 632 (cond 633 ((< start (1- (window-start window))) 634 (setq end (min (1- (window-start window)) end))) 635 ((< start (1+ (window-end window))) 636 (setq start (1+ (window-end window)))))) 637 ;; Round to multiple of lw. 638 (setq start (+ zero (* (ceiling (- start zero) lw) lw))) 639 (setq end (+ zero (* (truncate (- end zero) lw) lw))) 640 (when (< start end) 641 (remove-overlays start end 'nhexl t) 642 (put-text-property start end 'fontified nil) 643 (setq start (+ end lw)))))) 644 (let ((debug-new-count (nhexl--debug-count-ols))) 645 (message "Flushed %d overlays, %d remaining" 646 (- debug-count debug-new-count) debug-new-count))))) 647 648 (defun nhexl--make-line (from next zero &optional point) 649 (let* ((nextpos (min next (point-max))) 650 (lw (nhexl--line-width)) 651 (bufstr (buffer-substring from nextpos)) 652 (prop (if nhexl-obey-font-lock 'font-lock-face 'face)) 653 (i -1) 654 (s (concat 655 (if nhexl--put-LF-in-string (unless (eq zero from) "\n")) 656 (format (if (or (null point) 657 (< point from) 658 (>= point next)) 659 (propertize "%08x:" prop 'hexl-address-region) 660 ;; The `face' property overrides the `font-lock-face' 661 ;; property (instead of being combined), but we want the 662 ;; `highlight' face to be present regardless of 663 ;; font-lock-mode, so we can't use font-lock-face. 664 (propertize "%08x:" 'face 665 (if (or font-lock-mode 666 (not nhexl-obey-font-lock)) 667 '(highlight hexl-address-region default) 668 'highlight))) 669 (- from zero)) 670 (eval-when-compile (propertize " " 'display '(space :align-to 12))) 671 (mapconcat (lambda (c) 672 (setq i (1+ i)) 673 ;; FIXME: In multibyte buffers, do something clever 674 ;; about non-ascii chars. 675 (let ((s (format "%02x" c)) 676 face) 677 (when (and isearch-mode 678 (memq (setq face (get-char-property 679 (+ i from) 'face)) 680 '(lazy-highlight isearch))) 681 (put-text-property 0 (length s) 'face 682 `(,face default) s)) 683 (when (and point (eq point (+ from i))) 684 (if nhexl-nibble-edit-mode 685 (let ((nib (min (nhexl--nibble point) 686 (1- (length s))))) 687 (put-text-property nib (1+ nib) 688 'face '(highlight default) 689 s)) 690 (put-text-property 0 (length s) 691 'face '(highlight default) 692 s))) 693 (if (not (zerop (mod (1+ i) nhexl-group-size))) 694 ;; FIXME: If this char and the next are both 695 ;; covered by isearch highlight, we should 696 ;; also highlight the space. 697 s (concat s " ")))) 698 bufstr 699 "") 700 (if (> next nextpos) 701 (make-string (+ (/ (1+ (- next nextpos)) nhexl-group-size) 702 (* (- next nextpos) 2)) 703 ?\s)) 704 (if nhexl-separate-line 705 (concat "\n" 706 (propertize " " 'display 707 `(space :align-to 12))) 708 (propertize " " 'display 709 `(space :align-to 710 ,(+ (* lw 2) ;digits 711 (/ lw nhexl-group-size) ;spaces 712 12 3))))))) ;addr + borders 713 (font-lock-append-text-property 0 (length s) prop 'default s) 714 ;; If the first char of the text has a button (e.g. it's part of 715 ;; a hyperlink), clicking in the hex part of the display might signal 716 ;; an error because it thinks we're clicking on the hyperlink. 717 ;; So override the relevant properties. 718 (put-text-property 0 (length s) 'keymap (make-sparse-keymap) s) 719 (put-text-property 0 (length s) 'follow-link #'ignore s) 720 ;; Override any `category' property that might otherwise be inherited from 721 ;; the text (e.g. that of some button). 722 ;; FIXME: This doesn't have the intended effect! 723 (put-text-property 0 (length s) 'category t s) 724 s)) 725 726 (defun nhexl--jit (from to) 727 (let ((zero (save-restriction (widen) (point-min))) 728 (lw (nhexl--line-width))) 729 (setq from (max (point-min) 730 (+ zero (* (truncate (- from zero) lw) lw)))) 731 (setq to (min (point-max) 732 (+ zero (* (ceiling (- to zero) lw) lw)))) 733 (remove-overlays from to 'nhexl t) 734 (remove-text-properties from to '(display)) 735 (save-excursion 736 (goto-char from) 737 (while (search-forward "\n" to t) 738 (put-text-property (match-beginning 0) (match-end 0) 739 'display (copy-sequence "␊")))) 740 (while (< from to) 741 742 (cl-decf nhexl--overlay-counter) 743 (when (and (= nhexl--overlay-counter 0) 744 ;; If the user enabled jit-lock-stealth fontification, then 745 ;; removing overlays is just a waste since 746 ;; jit-lock-stealth will restore them anyway. 747 (not jit-lock-stealth-time)) 748 ;; (run-with-idle-timer 0 nil #'nhexl--flush-overlays (current-buffer)) 749 ) 750 751 (let* ((next (+ from lw)) 752 (ol (make-overlay from next)) 753 (s (nhexl--make-line from next zero nhexl--point)) 754 (c (char-before next))) 755 (when nhexl-separate-line 756 (dotimes (i (- (min (point-max) next) from 1)) 757 (let ((ol (make-overlay (+ from i) (+ from i 1)))) 758 (overlay-put ol 'nhexl t) 759 (overlay-put ol 'after-string 760 (propertize " " 'display 761 `(space :align-to 762 ,(+ (* (1+ i) 2) ;digits 763 (/ (1+ i) nhexl-group-size) ;spaces 764 12))))))) 765 (unless (or nhexl--put-LF-in-string (>= next (point-max))) 766 ;; Display tables aren't applied to strings in `display' properties, 767 ;; so we have to mimick it by hand. 768 (let ((cdisplay (aref nhexl--display-table 769 (if enable-multibyte-characters c 770 (unibyte-char-to-multibyte c))))) 771 (put-text-property (1- next) next 772 'display (concat 773 (string (cond 774 ((eq c ?\n) ?␊) 775 (cdisplay (aref cdisplay 0)) 776 (t c))) 777 ;; Explicit set a `default' face 778 ;; lest it gets nhexl-ascii-region. 779 (eval-when-compile 780 (propertize "\n" 'face 'default)))))) 781 (overlay-put ol 'nhexl t) 782 (overlay-put ol (if nhexl-obey-font-lock 'font-lock-face 'face) 783 'hexl-ascii-region) 784 ;; Make sure these overlays have less priority than that of (say) 785 ;; the region highlighting (since they're rather small). Another way 786 ;; to do it would be to add an overlay over the whole buffer with the 787 ;; `face' property. 788 (overlay-put ol 'priority most-negative-fixnum) 789 (overlay-put ol 'before-string s) 790 ;; (overlay-put ol 'after-string "\n") 791 (setq from next))) 792 )) 793 794 (defun nhexl--refresh-cursor (&optional pos) 795 (unless pos (setq pos (point))) 796 (let* ((zero (save-restriction (widen) (point-min))) 797 (lw (nhexl--line-width)) 798 (n (truncate (- pos zero) lw)) 799 (from (max (point-min) (+ zero (* n lw)))) 800 (to (min (point-max) (+ zero (* (1+ n) lw))))) 801 (with-silent-modifications 802 (put-text-property from to 'fontified nil)))) 803 804 (defun nhexl--header-line () 805 ;; FIXME: merge with nhexl--make-line? 806 ;; FIXME: Memoize last line to avoid recomputation! 807 (let* ((zero (save-restriction (widen) (point-min))) 808 (lw (nhexl--line-width)) 809 (text 810 (let ((tmp ())) 811 (dotimes (i lw) 812 (setq i (logand i #xf)) 813 (push (if (< i 10) (+ i ?0) (+ i -10 ?a)) tmp)) 814 (apply #'string (nreverse tmp)))) 815 (pos (1+ (mod (- (point) zero) lw))) 816 (i 0)) 817 (put-text-property (1- pos) pos 'face 'highlight text) 818 (concat 819 (eval-when-compile (propertize " " 'display '(space :align-to 0))) 820 "Address:" 821 (eval-when-compile (propertize " " 'display '(space :align-to 12))) 822 (mapconcat (lambda (c) 823 (setq i (1+ i)) 824 (let ((s (string c c))) 825 (when (eql i pos) 826 (if nhexl-nibble-edit-mode 827 (let ((nib (min (nhexl--nibble (point)) 828 (1- (length s))))) 829 (put-text-property nib (1+ nib) 830 'face 'highlight 831 s)) 832 (put-text-property 0 (length s) 833 'face 'highlight 834 s))) 835 (if (not (zerop (mod i nhexl-group-size))) 836 s 837 (concat 838 s (propertize " " 'display 839 `(space :align-to 840 ,(+ (* i 2) ;digits 841 (/ i nhexl-group-size) ;spaces 842 12))))))) ;addr 843 text 844 "") 845 (unless nhexl-separate-line 846 (concat 847 (propertize " " 'display 848 `(space :align-to 849 ,(+ (* lw 2) ;digits 850 (/ lw nhexl-group-size) ;spaces 851 12 3))) ;addr + border 852 text))))) 853 854 855 (defun nhexl--post-command () 856 (when (/= (point) nhexl--point) 857 (let ((zero (save-restriction (widen) (point-min))) 858 (lw (nhexl--line-width)) 859 (oldpoint nhexl--point)) 860 (setq nhexl--point (point)) 861 (nhexl--refresh-cursor) 862 ;; (nhexl--jit (point) (1+ (point))) 863 (if (/= (truncate (- (point) zero) lw) 864 (truncate (- oldpoint zero) lw)) 865 (nhexl--refresh-cursor oldpoint))))) 866 867 (defun nhexl--isearch-match-hex-bytes (string bound noerror) 868 ;; "57a" can be taken as "57a." or ".57a", but we currently 869 ;; only handle "57a." 870 ;; TODO: Maybe we could support hex regexps as well? 871 (let ((i 0) 872 (chars ())) 873 (while (< (1+ i) (length string)) 874 (push (string-to-number (substring string i (+ i 2)) 16) 875 chars) 876 (setq i (+ i 2))) 877 (let* ((base (regexp-quote (apply #'unibyte-string (nreverse chars)))) 878 (re 879 (concat (if (>= i (length string)) 880 base 881 (cl-assert (= (1+ i) (length string))) 882 (let ((nibble (string-to-number (substring string i) 16))) 883 ;; FIXME: if one of the two bounds is a special char 884 ;; like `]` or `^' we can get into trouble! 885 (concat base 886 (unibyte-string ?\[ (* 16 nibble) ?- 887 (+ 15 (* 16 nibble)) ?\])))) 888 ;; We also search for the literal hex string here, so the 889 ;; search stops as soon as one is found, otherwise we too 890 ;; easily fall into the trap of bug#33708 where at every 891 ;; cycle we first search unsuccessfully through the whole 892 ;; buffer with one kind of search before trying the 893 ;; other search. 894 ;; Don't bother regexp-quoting the string since we know 895 ;; it's only made of hex chars! 896 "\\|" string))) 897 (let ((case-fold-search nil)) 898 (funcall (if isearch-forward 899 #'re-search-forward 900 #'re-search-backward) 901 re bound noerror))))) 902 903 (defun nhexl--isearch-search-fun (orig-fun) 904 (let ((def-fun (funcall orig-fun))) 905 (lambda (string bound noerror) 906 (unless bound 907 (setq bound (if isearch-forward (point-max) (point-min)))) 908 ;; The order we used for the different searches is important: 909 ;; - First we do the hex-address search since it's always fast even in 910 ;; very large buffers. 911 ;; - Then we do the hex-bytes search. 912 ;; - Only last we fallback to the def-fun: if the user wants to 913 ;; do an hex-bytes search, the def-fun will likely fail but not 914 ;; without first scanning the whole buffer which can take a while, 915 ;; as in bug#33708. 916 (let ((startpos (point)) 917 def) 918 ;; Hex address search. 919 (when (and nhexl-isearch-hex-addresses 920 (> (length string) 1) 921 (string-match-p "\\`[[:xdigit:]]+:?\\'" string)) 922 ;; Could be a hexadecimal address. 923 (goto-char startpos) 924 (let ((newdef (nhexl--isearch-match-hex-address string bound noerror))) 925 (when newdef 926 (setq def newdef) 927 (setq bound (match-beginning 0))))) 928 ;; Hex bytes search 929 (when (and nhexl-isearch-hex-bytes 930 (> (length string) 1) 931 (string-match-p "\\`[[:xdigit:]]+\\'" string)) 932 ;; Could be a search pattern specified in hex. 933 (goto-char startpos) 934 (let ((newdef (nhexl--isearch-match-hex-bytes string bound noerror))) 935 (when newdef 936 (setq def newdef) 937 (setq bound (match-beginning 0))))) 938 ;; Normal search. 939 (progn 940 (goto-char startpos) 941 (let ((newdef (funcall def-fun string bound noerror))) 942 (when newdef 943 (setq def newdef) 944 (setq bound (match-beginning 0))))) 945 (when def 946 (goto-char def) 947 def))))) 948 949 (defun nhexl--isearch-match-hex-address (string bound _noerror) 950 ;; FIXME: The code below works well to find the address, but the 951 ;; resulting isearch-highlighting is wrong (the char(s) at that position 952 ;; is highlighted, instead of the actual address matched in the 953 ;; before-string). 954 (let* ((addr (string-to-number string 16)) 955 ;; If `string' says "7a:", then it's "anchored", meaning that 956 ;; we'll only look for nearest address of the form "XXX7a" 957 ;; whereas if `string' says just "7a", then we look for nearest 958 ;; address of the form "XXX7a", or "XXX7aX", or "XXX7aXX", ... 959 (anchored (eq ?: (aref string (1- (length string))))) 960 (mod (lsh 1 (* 4 (- (length string) (if anchored 1 0))))) 961 (base (save-restriction (widen) (point-min))) 962 (bestnext nil) 963 (maxaddr (- (max (point) bound) base))) 964 (while (< addr maxaddr) 965 (let ((next (+ addr base (* (/ (- (point) base) mod) mod)))) 966 (if isearch-forward 967 (progn 968 (when (<= next (point)) 969 (setq next (+ next mod))) 970 (cl-assert (> next (point))) 971 (and (< next bound) 972 (or (null bestnext) (< next bestnext)) 973 (setq bestnext next))) 974 (when (>= next (point)) 975 (setq next (- next mod))) 976 (cl-assert (< next (point))) 977 (and (> next bound) 978 (or (null bestnext) (> next bestnext)) 979 (setq bestnext next)))) 980 (let ((nextmod (* mod 16))) 981 (if (or anchored 982 ;; Overflow! let's get out of the loop right away. 983 (< nextmod mod)) 984 (setq maxaddr -1) 985 (setq addr (* addr 16)) 986 (setq mod nextmod)))) 987 (when bestnext 988 (let* ((lw (nhexl--line-width)) 989 (me (+ (* lw (/ (- bestnext (point-min)) lw)) 990 (point-min) lw))) 991 (set-match-data (list bestnext me)) 992 (if isearch-forward 993 ;; Go to just before the last char on the line, 994 ;; otherwise, the cursor ends up on the 995 ;; next line! 996 (1- me) 997 bestnext))))) 998 999 (advice-add 'lazy-highlight-cleanup :before 1000 #'nhexl--isearch-highlight-cleanup) 1001 (defun nhexl--isearch-highlight-cleanup (&rest _) 1002 (when (and nhexl-mode nhexl-isearch-hex-highlight) 1003 (with-silent-modifications 1004 (dolist (ol isearch-lazy-highlight-overlays) 1005 (when (and (overlayp ol) (eq (overlay-buffer ol) (current-buffer))) 1006 (put-text-property (overlay-start ol) (overlay-end ol) 1007 'fontified nil)))))) 1008 1009 (advice-add 'isearch-lazy-highlight-match :after 1010 #'nhexl--isearch-highlight-match) 1011 (defun nhexl--isearch-highlight-match (&optional mb me) 1012 (when (and nhexl-mode nhexl-isearch-hex-highlight 1013 (integerp mb) (integerp me)) 1014 (with-silent-modifications 1015 (put-text-property mb me 'fontified nil)))) 1016 1017 (defun nhexl--line-width-watcher (_sym _newval op where) 1018 (when (eq op 'set) 1019 (dolist (buf (if where (list where) (buffer-list))) 1020 (with-current-buffer buf 1021 (when nhexl-mode (nhexl--flush)))))) 1022 1023 (when (fboundp 'add-variable-watcher) 1024 (add-variable-watcher 'nhexl-line-width #'nhexl--line-width-watcher)) 1025 1026 (defun nhexl--window-size-change (frame-or-window) 1027 (when (eq t (default-value 'nhexl-line-width)) 1028 (if (windowp frame-or-window) ;Emacs≥27 1029 (with-selected-window frame-or-window 1030 (nhexl--adjust-to-width)) 1031 (dolist (win (window-list frame-or-window 'nomini)) 1032 (when (buffer-local-value 'nhexl-mode (window-buffer win)) 1033 (with-selected-window win (nhexl--adjust-to-width))))))) 1034 1035 (defun nhexl--window-config-change () 1036 ;; Doing it only from `window-size-change-functions' is not sufficient 1037 ;; because it's not run when you set-window-buffer. 1038 (when (eq t (default-value 'nhexl-line-width)) 1039 (nhexl--adjust-to-width))) 1040 1041 (defun nhexl--adjust-to-width () 1042 ;; FIXME: What should we do with buffers displayed in several windows of 1043 ;; different width? 1044 (let ((win (get-buffer-window))) 1045 (when win 1046 (let* ((width (window-text-width win)) 1047 (bytes (/ (- width 1048 (eval-when-compile 1049 (+ 9 ;Address 1050 3 ;Spaces between address and hex area 1051 4))) ;Spaces between hex area and ascii area 1052 (+ 3 (/ 1.0 nhexl-group-size)))) ;Columns per byte 1053 (pow2bytes (lsh 1 (truncate (log bytes 2))))) 1054 (when (> (/ bytes pow2bytes) 1.5) 1055 ;; Add 1½ steps: 4, *6*, 8, *12*, 16, *24*, 32, *48*, 64 1056 (setq pow2bytes (+ pow2bytes (/ pow2bytes 2)))) 1057 (unless (eql pow2bytes nhexl-line-width) 1058 (setq-local nhexl-line-width pow2bytes)))))) 1059 1060 ;;;;; The main prefix command. 1061 1062 (defvar nhexl-universal-argument-map 1063 (let ((map (make-sparse-keymap))) 1064 (set-keymap-parent map universal-argument-map) 1065 (define-key map [?\C-u] 'universal-argument-more) 1066 (define-key map [remap digit-argument] 'nhexl-digit-argument) 1067 (dolist (k '("a" "b" "c" "d" "e" "f")) 1068 (define-key map k 'nhexl-digit-argument)) 1069 map) 1070 "Keymap used while processing nhexl-mode's \\[universal-argument].") 1071 1072 ;; FIXME: Using advice is ugly! 1073 1074 ;; Instead of an advice, we'd prefer to replace universal-argument--description 1075 ;; on prefix-command-echo-keystrokes-functions, but there's no mechanism to 1076 ;; do that. 1077 (advice-add 'universal-argument--description :around 1078 #'nhexl--universal-argument-description) 1079 (defun nhexl--universal-argument-description (orig-fun &rest args) 1080 (cond 1081 ((not nhexl-mode) (apply orig-fun args)) 1082 ((null prefix-arg) nil) 1083 (t 1084 (concat "C-u" 1085 (pcase prefix-arg 1086 (`(-) " -") 1087 (`(,(and (pred integerp) n)) 1088 (let ((str "")) 1089 (while (and (> n 4) (= (mod n 4) 0)) 1090 (setq str (concat str " C-u")) 1091 (setq n (/ n 4))) 1092 (if (= n 4) str (format " %s" prefix-arg)))) 1093 ((pred integerp) (format " #x%X" prefix-arg)) 1094 (_ (format " %s" prefix-arg))))))) 1095 1096 (advice-add 'universal-argument--mode :around 1097 #'nhexl--universal-argument-mode) 1098 (defun nhexl--universal-argument-mode (orig-fun &rest args) 1099 (if (not nhexl-mode) 1100 (apply orig-fun args) 1101 (let ((universal-argument-map nhexl-universal-argument-map)) 1102 (apply orig-fun args)))) 1103 1104 (defun nhexl-digit-argument (arg) 1105 "Part of the hexadecimal numeric argument for the next command. 1106 \\[universal-argument] following digits or minus sign ends the argument." 1107 (interactive "P") 1108 (prefix-command-preserve-state) 1109 (let* ((keys (this-command-keys)) 1110 (key (aref keys (1- (length keys)))) 1111 (char (if (integerp key) (logand key #x7f))) 1112 (digit (cond 1113 ((<= ?a char ?f) (+ 10 (- char ?a))) 1114 ((<= ?A char ?F) (+ 10 (- char ?A))) 1115 ((<= ?0 char ?9) (- char ?0))))) 1116 (setq prefix-arg (cond ((integerp arg) 1117 (+ (* arg 16) 1118 (if (< arg 0) (- digit) digit))) 1119 ((eq arg '-) 1120 ;; Treat -0 as just -, so that -01 will work. 1121 (if (zerop digit) '- (- digit))) 1122 (t 1123 digit)))) 1124 (universal-argument--mode)) 1125 1126 ;;;; ChangeLog: 1127 1128 ;; 2020-01-10 Alessio Di Mauro <dimauro.alessio@gmail.com> 1129 ;; 1130 ;; * packages/nhexl-mode/nhexl-mode.el (nhexl-mode-map): Remap EOL/BOL 1131 ;; 1132 ;; Copyright-paperwork-exempt: yes 1133 ;; 1134 ;; (nhexl-move-beginning-of-line, nhexl-move-end-of-line): New commands 1135 ;; 1136 ;; 2019-10-15 Stefan Monnier <monnier@iro.umontreal.ca> 1137 ;; 1138 ;; * packages/nhexl-mode/nhexl-mode.el (nhexl-separate-line): New user 1139 ;; config 1140 ;; 1141 ;; (nhexl--make-line, nhexl--jit, nhexl--header-line): Obey it. 1142 ;; (nhexl-mode): Better take advantage of new window-size-change-functions. 1143 ;; 1144 ;; 2019-10-15 Stefan Monnier <monnier@iro.umontreal.ca> 1145 ;; 1146 ;; * packages/nhexl-mode/nhexl-mode.el (nhexl-group-size): New user config 1147 ;; 1148 ;; (nhexl--make-line, nhexl--header-line, nhexl--adjust-to-width): Obey it. 1149 ;; (nhexl--window-size-change): Adjust to Emacs-27's new calling convention 1150 ;; of window-size-change-functions. 1151 ;; (nhexl-mode): Use the local part of window-size-change-functions when it 1152 ;; works reliably. 1153 ;; 1154 ;; 2019-05-05 Stefan Monnier <monnier@iro.umontreal.ca> 1155 ;; 1156 ;; * nhexl-mode.el (nhexl-nibble-self-insert): Obey overwrite-mode 1157 ;; 1158 ;; (nhexl-mode-map): Rebind overwrite-mode so we always use 1159 ;; binary-overwrite. 1160 ;; (nhexl-hex-edit-mode): New alias. 1161 ;; 1162 ;; 2018-12-14 Stefan Monnier <monnier@iro.umontreal.ca> 1163 ;; 1164 ;; * nhexl-mode/nhexl-mode.el: Fix performance bug#33708 1165 ;; 1166 ;; (nhexl--isearch-match-hex-bytes): Also search for the literal hex text. 1167 ;; Make sure we use unibyte strings. 1168 ;; (nhexl--isearch-search-fun): Re-order the different searches. 1169 ;; (nhexl--isearch-highlight-cleanup, nhexl--isearch-highlight-match): 1170 ;; Don't accidentally mark the buffer as modified. 1171 ;; 1172 ;; 2018-12-10 Stefan Monnier <monnier@iro.umontreal.ca> 1173 ;; 1174 ;; * nhexl-mode.el: Add isearch and highlight to hex area 1175 ;; 1176 ;; (nhexl-isearch-hex-addresses, nhexl-isearch-hex-bytes) 1177 ;; (nhexl-isearch-hex-highlight): New vars. 1178 ;; (nhexl--make-line): Copy isearch highlighting from the buffer when 1179 ;; applicable. 1180 ;; (nhexl--isearch-match-hex-bytes): New function. 1181 ;; (nhexl--isearch-match-hex-address): New function, extracted from 1182 ;; nhexl--isearch-search-fun. Match the whole corresponding line. 1183 ;; (nhexl--isearch-search-fun): Use them. 1184 ;; (nhexl--isearch-highlight-cleanup, nhexl--isearch-highlight-match): New 1185 ;; functions. 1186 ;; (lazy-highlight-cleanup, isearch-lazy-highlight-match): Use them as 1187 ;; advice to propagate isearch highlight to the hex area. 1188 ;; 1189 ;; 2018-11-07 Stefan Monnier <monnier@iro.umontreal.ca> 1190 ;; 1191 ;; * nhexl-mode.el: Improve handling of mouse events 1192 ;; 1193 ;; (nhexl--posn-hexadjust): New function extracted from 1194 ;; nhexl-mouse-set-point. 1195 ;; (nhexl-mouse-set-point): Use it. 1196 ;; (nhexl-mouse-drag-region, nhexl-mouse-set-region): New commands. 1197 ;; (nhexl-mode-map): Remap to them. 1198 ;; (nhexl--make-line): Circumvent some misbehavior in the presence of 1199 ;; buttons. 1200 ;; 1201 ;; 2018-11-06 Stefan Monnier <monnier@iro.umontreal.ca> 1202 ;; 1203 ;; * nhexl-mode.el: Make C-u use hexadecimal 1204 ;; 1205 ;; (nhexl-universal-argument-map): New var. 1206 ;; (nhexl--universal-argument-description) 1207 ;; (nhexl--universal-argument-mode): New advice functions. 1208 ;; (nhexl-digit-argument): New command. 1209 ;; 1210 ;; 2018-04-27 Stefan Monnier <monnier@iro.umontreal.ca> 1211 ;; 1212 ;; * nhexl-mode/nhexl-mode.el: Get rid of the spurious top empty line 1213 ;; 1214 ;; (nhexl-mode): Set word-wrap to nil. 1215 ;; (nhexl-mouse-set-point): Don't bother sanity checking the string. 1216 ;; (nhexl--put-LF-in-string): New var. 1217 ;; (nhexl--make-line, nhexl--jit): Obey it. 1218 ;; (nhexl--header-line): Pre-construct some strings. 1219 ;; 1220 ;; 2018-04-26 Stefan Monnier <monnier@iro.umontreal.ca> 1221 ;; 1222 ;; * nhexl-mode/nhexl-mode.el: Improve multi-window behavior 1223 ;; 1224 ;; (nhexl--nibble) <var>: Remove. 1225 ;; (nhexl--nibbles): New var to replace it. 1226 ;; (nhexl--nibble) <fun>: Return the nibble offset for the selected window. 1227 ;; (nhexl--nibble-set): Set the nibble offset for the selected window. 1228 ;; (nhexl-mouse-set-point): New command. 1229 ;; (nhexl-mode-map): Bind it. 1230 ;; (nhexl--point): Move. 1231 ;; (nhexl--jit): Simplify back. 1232 ;; (nhexl--window-config-change): New function. 1233 ;; (nhexl-mode): Use it for window-configuration-change-hook. Immediately 1234 ;; adjust to width if applicable. 1235 ;; 1236 ;; 2018-04-25 Stefan Monnier <monnier@iro.umontreal.ca> 1237 ;; 1238 ;; * nhexl-mode/nhexl-mode.el: Fix minor issues 1239 ;; 1240 ;; Bump required Emacs to 24.4 (since we use nadvice). 1241 ;; (nhexl--refresh-cursor): Move. 1242 ;; (nhexl-overwrite-only-mode-map): Add remapping for backward-delete-char. 1243 ;; (nhexl--make-line): Don't refer to nhexl--point directly. Fix 1244 ;; highlighting of the point's address when font-lock is off. 1245 ;; (nhexl--jit): Pass nhexl--point to it. 1246 ;; (nhexl--header-line): Don't use nhexl--point so it works correctly with 1247 ;; multiple windows. 1248 ;; (nhexl--window-config-change): Rename to nhexl--adjust-to-width. 1249 ;; 1250 ;; 2018-04-23 Stefan Monnier <monnier@iro.umontreal.ca> 1251 ;; 1252 ;; * nhexl-mode/nhexl-mode.el (nhexl-line-width): Allow dynamic adjust 1253 ;; 1254 ;; (nhexl--line-width): New function. 1255 ;; (nhexl--window-size-change): New function. 1256 ;; (nhexl-mode): Use it. 1257 ;; (nhexl--flush, nhexl--window-config-change): New functions. 1258 ;; (nhexl--jit): Set 'priority' of overlay so as not to hide the region. 1259 ;; (nhexl--header-line): Don't use letters past `f` for columns >15. 1260 ;; (nhexl--line-width-watcher): New function. 1261 ;; (nhexl-line-width): Use it as watcher when applicable. 1262 ;; 1263 ;; 2018-04-19 Stefan Monnier <monnier@iro.umontreal.ca> 1264 ;; 1265 ;; * nhexl-mode/nhexl-mode.el: Let isearch look for addresses as well 1266 ;; 1267 ;; (nhexl-obey-font-lock): New custom var. 1268 ;; (nhexl--make-line, nhexl--jit): Use it. 1269 ;; (nhexl-silently-convert-to-unibyte): New custom var. 1270 ;; (nhexl-mode): Use it. Set isearch-search-fun-function. Don't bother 1271 ;; switching to unibyte for pure-ascii buffers. Be more robust for the case 1272 ;; when nhexl-mode is enabled while it was already enabled. 1273 ;; (nhexl--isearch-search-fun): New function. 1274 ;; (nhexl--font-lock-switch): New function. 1275 ;; 1276 ;; 2018-04-16 Stefan Monnier <monnier@iro.umontreal.ca> 1277 ;; 1278 ;; * nhexl-mode.el: Hide undisplayable chars by default 1279 ;; 1280 ;; (nhexl-line-width): Make it a defcustom. 1281 ;; (nhexl-display-unprintables): New defcustom. 1282 ;; (nhexl--display-table): Avoid \NNN by default. 1283 ;; (nhexl-mode): Suggest converting to unibyte when applicable. 1284 ;; (nhexl-scroll-down, nhexl-scroll-up): New commands. 1285 ;; (nhexl-mode-map): Use them. 1286 ;; 1287 ;; 2018-04-15 Stefan Monnier <monnier@iro.umontreal.ca> 1288 ;; 1289 ;; * nhexl-mode.el: Bump version number for new release 1290 ;; 1291 ;; 2018-04-15 Stefan Monnier <monnier@iro.umontreal.ca> 1292 ;; 1293 ;; * nhexl-mode.el (nhexl-overwrite-only-mode): New minor mode. 1294 ;; 1295 ;; 2018-04-12 Stefan Monnier <monnier@iro.umontreal.ca> 1296 ;; 1297 ;; * nhexl-mode.el: Add our own line-movement functions 1298 ;; 1299 ;; (nhexl-mode-map): New keymap. 1300 ;; (nhexl-next-line, nhexl-previous-line): New commands. 1301 ;; (nhexl-nibble-next-line, nhexl-nibble-previous-line): Remove. 1302 ;; 1303 ;; 2018-04-12 Stefan Monnier <monnier@iro.umontreal.ca> 1304 ;; 1305 ;; * nhexl-mode.el (nhexl-nibble-edit-mode): New minor mode 1306 ;; 1307 ;; 2016-08-08 Stefan Monnier <monnier@iro.umontreal.ca> 1308 ;; 1309 ;; * nhexl-mode.el: Use cl-lib 1310 ;; 1311 ;; 2012-03-25 Chong Yidong <cyd@gnu.org> 1312 ;; 1313 ;; nhexl-mode.el: Fix last change. 1314 ;; 1315 ;; 2012-03-24 Chong Yidong <cyd@gnu.org> 1316 ;; 1317 ;; Commentary tweaks for csv-mode, ioccur, and nhexl-mode packages. 1318 ;; 1319 ;; 2012-03-20 Stefan Monnier <monnier@iro.umontreal.ca> 1320 ;; 1321 ;; Add nhexl-mode. 1322 ;; 1323 1324 1325 1326 (provide 'nhexl-mode) 1327 ;;; nhexl-mode.el ends here