pdf-isearch.el (31156B)
1 ;;; pdf-isearch.el --- Isearch in pdf buffers. -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2013, 2014 Andreas Politz 4 5 ;; Author: Andreas Politz <politza@fh-trier.de> 6 ;; Keywords: files, multimedia 7 8 ;; This program is free software; you can redistribute it and/or modify 9 ;; it under the terms of the GNU General Public License as published by 10 ;; the Free Software Foundation, either version 3 of the License, or 11 ;; (at your option) any later version. 12 13 ;; This program is distributed in the hope that it will be useful, 14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 ;; GNU General Public License for more details. 17 18 ;; You should have received a copy of the GNU General Public License 19 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. 20 21 ;;; Commentary: 22 ;; 23 ;;; Todo: 24 ;; 25 ;; * Add the possibility to limit the search to a range of pages. 26 27 (require 'cl-lib) 28 (require 'pdf-util) 29 (require 'pdf-info) 30 (require 'pdf-misc) 31 (require 'pdf-view) 32 (require 'pdf-cache) 33 (require 'let-alist) 34 35 ;;; Code: 36 37 38 39 ;; * ================================================================== * 40 ;; * Customizations 41 ;; * ================================================================== * 42 43 (defgroup pdf-isearch nil 44 "Isearch in pdf buffers." 45 :group 'pdf-tools) 46 47 (defface pdf-isearch-match 48 '((((background dark)) (:inherit isearch)) 49 (((background light)) (:inherit isearch))) 50 "Face used to determine the colors of the current match." 51 :group 'pdf-isearch 52 :group 'pdf-tools-faces) 53 54 (defface pdf-isearch-lazy 55 '((((background dark)) (:inherit lazy-highlight)) 56 (((background light)) (:inherit lazy-highlight))) 57 "Face used to determine the colors of non-current matches." 58 :group 'pdf-isearch 59 :group 'pdf-tools-faces) 60 61 (defface pdf-isearch-batch 62 '((((background dark)) (:inherit match)) 63 (((background light)) (:inherit match))) 64 "Face used to determine the colors in `pdf-isearch-batch-mode'." 65 :group 'pdf-isearch 66 :group 'pdf-tools-faces) 67 68 (defcustom pdf-isearch-hyphenation-character "-" 69 "Characters used as hyphens when word searching." 70 :group 'pdf-isearch 71 :type 'string) 72 73 (defvar pdf-isearch-search-fun-function nil 74 "Search function used when searching. 75 76 Like `isearch-search-fun-function', though it should return a 77 function \(FN STRING &optional PAGES\), which in turn should 78 return a result like `pdf-info-search-regexp'.") 79 80 81 ;; * ================================================================== * 82 ;; * Internal Variables 83 ;; * ================================================================== * 84 85 (defvar-local pdf-isearch-current-page nil 86 "The page that is currently searched.") 87 88 (defvar-local pdf-isearch-current-match nil 89 "A list ((LEFT TOP RIGHT BOT) ...) of the current match or nil. 90 91 A match may contain more than one edges-element, e.g. when regexp 92 searching across multiple lines.") 93 94 (defvar-local pdf-isearch-current-matches nil 95 "A list of matches of the last search.") 96 97 (defvar-local pdf-isearch-current-parameter nil 98 "A list of search parameter \(search-string regex-p case-fold word-search\).") 99 100 101 ;; * ================================================================== * 102 ;; * Modes 103 ;; * ================================================================== * 104 105 (declare-function pdf-occur "pdf-occur.el") 106 (declare-function pdf-sync-backward-search "pdf-sync.el") 107 108 (defvar pdf-isearch-minor-mode-map 109 (let ((kmap (make-sparse-keymap))) 110 (define-key kmap [remap occur] 'pdf-occur) 111 kmap) 112 "Keymap used in `pdf-isearch-minor-mode'.") 113 114 (defvar pdf-isearch-active-mode-map 115 (let ((kmap (make-sparse-keymap))) 116 (set-keymap-parent kmap isearch-mode-map) 117 (define-key kmap (kbd "C-d") 'pdf-view-dark-minor-mode) 118 (define-key kmap (kbd "C-b") 'pdf-isearch-batch-mode) 119 (define-key kmap (kbd "M-s o") 'pdf-isearch-occur) 120 (define-key kmap (kbd "M-s s") 'pdf-isearch-sync-backward) 121 kmap) 122 "Keymap used in `pdf-isearch-active-mode'. 123 124 This keymap is used, when isearching in PDF buffers. Its parent 125 keymap is `isearch-mode-map'.") 126 127 (put 'image-scroll-up 'isearch-scroll t) 128 (put 'image-scroll-down 'isearch-scroll t) 129 130 (define-minor-mode pdf-isearch-active-mode 131 "This mode is enabled when isearch is active in a PDF file." 132 :group 'pdf-isearch 133 (cond 134 (pdf-isearch-active-mode 135 (set (make-local-variable 'isearch-mode-map) 136 pdf-isearch-active-mode-map) 137 (setq overriding-terminal-local-map 138 isearch-mode-map)) 139 (t 140 ;;(setq overriding-terminal-local-map nil) ? 141 (kill-local-variable 'isearch-mode-map)))) 142 143 ;;;###autoload 144 (define-minor-mode pdf-isearch-minor-mode 145 "Isearch mode for PDF buffer. 146 147 When this mode is enabled \\[isearch-forward], among other keys, 148 starts an incremental search in this PDF document. Since this mode 149 uses external programs to highlight found matches via 150 image-processing, proceeding to the next match may be slow. 151 152 Therefore two isearch behaviours have been defined: Normal isearch and 153 batch mode. The later one is a minor mode 154 \(`pdf-isearch-batch-mode'\), which when activated inhibits isearch 155 from stopping at and highlighting every single match, but rather 156 display them batch-wise. Here a batch means a number of matches 157 currently visible in the selected window. 158 159 The kind of highlighting is determined by three faces 160 `pdf-isearch-match' \(for the current match\), `pdf-isearch-lazy' 161 \(for all other matches\) and `pdf-isearch-batch' \(when in batch 162 mode\), which see. 163 164 Colors may also be influenced by the minor-mode 165 `pdf-view-dark-minor-mode'. If this is minor mode enabled, each face's 166 dark colors, are used (see e.g. `frame-background-mode'), instead 167 of the light ones. 168 169 \\{pdf-isearch-minor-mode-map} 170 While in `isearch-mode' the following keys are available. Note 171 that not every isearch command work as expected. 172 173 \\{pdf-isearch-active-mode-map}" 174 :group 'pdf-isearch 175 (pdf-util-assert-pdf-buffer) 176 (cond 177 (pdf-isearch-minor-mode 178 (when (boundp 'character-fold-search) 179 (setq-local character-fold-search nil)) 180 (set (make-local-variable 'isearch-search-fun-function) 181 (lambda nil 'pdf-isearch-search-function)) 182 (set (make-local-variable 'isearch-push-state-function) 183 'pdf-isearch-push-state-function) 184 (set (make-local-variable 'isearch-wrap-function) 185 'pdf-isearch-wrap-function) 186 (set (make-local-variable 'isearch-lazy-highlight) nil) 187 ;; Make our commands work in isearch-mode. 188 (set (make-local-variable 'isearch-allow-scroll) t) 189 (set (make-local-variable 'search-exit-option) 190 ;; This maybe edit or t, but edit would suppress our cmds 191 ;; in isearch-other-meta-char. 192 (not (not search-exit-option))) 193 ;; FIXME: Die Variable imagemagick-render-type entweder an anderer 194 ;; Stelle global setzen oder nur irgendwo auf den 195 ;; Performancegewinn hinweisen. 196 (when (and (boundp 'imagemagick-render-type) 197 (= 0 imagemagick-render-type)) 198 ;; This enormously speeds up rendering. 199 (setq imagemagick-render-type 1)) 200 (add-hook 'isearch-mode-hook 'pdf-isearch-mode-initialize nil t) 201 (add-hook 'isearch-mode-end-hook 'pdf-isearch-mode-cleanup nil t) 202 (add-hook 'isearch-update-post-hook 'pdf-isearch-update nil t)) 203 (t 204 (when (boundp 'character-fold-search) 205 (kill-local-variable 'character-fold-search)) 206 (kill-local-variable 'search-exit-option) 207 (kill-local-variable 'isearch-allow-scroll) 208 (kill-local-variable 'isearch-search-fun-function) 209 (kill-local-variable 'isearch-push-state-function) 210 (kill-local-variable 'isearch-wrap-function) 211 (kill-local-variable 'isearch-lazy-highlight) 212 (remove-hook 'isearch-update-post-hook 'pdf-isearch-update t) 213 (remove-hook 'isearch-mode-hook 'pdf-isearch-mode-initialize t) 214 (remove-hook 'isearch-mode-end-hook 'pdf-isearch-mode-cleanup t)))) 215 216 (define-minor-mode pdf-isearch-batch-mode 217 "Isearch PDF documents batch-wise. 218 219 If this mode is enabled, isearching does not stop at every match, 220 but rather moves to the next one not currently visible. This 221 behaviour is much faster than ordinary isearch, since far less 222 different images have to be displayed." 223 :group 'pdf-isearch 224 (when isearch-mode 225 (pdf-isearch-redisplay) 226 (pdf-isearch-message 227 (if pdf-isearch-batch-mode "batch mode" "isearch mode")))) 228 229 230 231 ;; * ================================================================== * 232 ;; * Isearch interface 233 ;; * ================================================================== * 234 235 (defvar pdf-isearch-filter-matches-function nil 236 "A function for filtering isearch matches. 237 238 The function receives one argument: a list of matches, each 239 being a list of edges. It should return a subset of this list. 240 Edge coordinates are in image-space.") 241 242 (defvar pdf-isearch-narrow-to-page nil 243 "Non-nil, if the search should be limited to the current page.") 244 245 (defun pdf-isearch-search-function (string &rest _) 246 "Search for STRING in the current PDF buffer. 247 248 This is a Isearch interface function." 249 (when (> (length string) 0) 250 (let ((same-search-p (pdf-isearch-same-search-p)) 251 (oldpage pdf-isearch-current-page) 252 (matches (pdf-isearch-search-page string)) 253 next-match) 254 ;; matches is a list of list of edges ((x0 y1 x1 y2) ...), 255 ;; sorted top to bottom ,left to right. Coordinates are in image 256 ;; space. 257 (unless isearch-forward 258 (setq matches (reverse matches))) 259 (when pdf-isearch-filter-matches-function 260 (setq matches (funcall pdf-isearch-filter-matches-function matches))) 261 ;; Where to go next ? 262 (setq pdf-isearch-current-page (pdf-view-current-page) 263 pdf-isearch-current-matches matches 264 next-match 265 (pdf-isearch-next-match 266 oldpage pdf-isearch-current-page 267 pdf-isearch-current-match matches 268 same-search-p 269 isearch-forward) 270 pdf-isearch-current-parameter 271 (list string isearch-regexp 272 isearch-case-fold-search isearch-word)) 273 (cond 274 (next-match 275 (setq pdf-isearch-current-match next-match) 276 (pdf-isearch-hl-matches next-match matches) 277 (pdf-isearch-focus-match next-match) 278 ;; Don't get off track. 279 (when (or (and (bobp) (not isearch-forward)) 280 (and (eobp) isearch-forward)) 281 (goto-char (1+ (/ (buffer-size) 2)))) 282 ;; Signal success to isearch. 283 (if isearch-forward 284 (re-search-forward ".") 285 (re-search-backward "."))) 286 ((and (not pdf-isearch-narrow-to-page) 287 (not (pdf-isearch-empty-match-p matches))) 288 (let ((next-page (pdf-isearch-find-next-matching-page 289 string pdf-isearch-current-page t))) 290 (when next-page 291 (pdf-view-goto-page next-page) 292 (pdf-isearch-search-function string)))))))) 293 294 (defun pdf-isearch-push-state-function () 295 "Push the current search state. 296 297 This is a Isearch interface function." 298 (let ((hscroll (window-hscroll)) 299 (vscroll (window-vscroll)) 300 (parms pdf-isearch-current-parameter) 301 (matches pdf-isearch-current-matches) 302 (match pdf-isearch-current-match) 303 (page pdf-isearch-current-page)) 304 (lambda (_state) 305 (setq pdf-isearch-current-parameter parms 306 pdf-isearch-current-matches matches 307 pdf-isearch-current-match match 308 pdf-isearch-current-page page) 309 310 (pdf-view-goto-page pdf-isearch-current-page) 311 (when pdf-isearch-current-match 312 (pdf-isearch-hl-matches 313 pdf-isearch-current-match 314 pdf-isearch-current-matches)) 315 (image-set-window-hscroll hscroll) 316 (image-set-window-vscroll vscroll)))) 317 318 (defun pdf-isearch-wrap-function () 319 "Go to first or last page. 320 321 This is a Isearch interface function." 322 (let ((page (if isearch-forward 323 1 324 (pdf-cache-number-of-pages)))) 325 (unless (or pdf-isearch-narrow-to-page 326 (= page (pdf-view-current-page))) 327 (pdf-view-goto-page page) 328 (let ((next-screen-context-lines 0)) 329 (if (= page 1) 330 (image-scroll-down) 331 (image-scroll-up))))) 332 (setq pdf-isearch-current-match nil)) 333 334 (defun pdf-isearch-mode-cleanup () 335 "Cleanup after exiting Isearch. 336 337 This is a Isearch interface function." 338 (pdf-isearch-active-mode -1) 339 (pdf-view-redisplay)) 340 341 (defun pdf-isearch-mode-initialize () 342 "Initialize isearching. 343 344 This is a Isearch interface function." 345 (pdf-isearch-active-mode 1) 346 (setq pdf-isearch-current-page (pdf-view-current-page) 347 pdf-isearch-current-match nil 348 pdf-isearch-current-matches nil 349 pdf-isearch-current-parameter nil) 350 (goto-char (1+ (/ (buffer-size) 2)))) 351 352 (defun pdf-isearch-same-search-p (&optional ignore-search-string-p) 353 "Return non-nil, if search parameter have not changed. 354 355 Parameter inspected are `isearch-string' (unless 356 IGNORE-SEARCH-STRING-P is t) and `isearch-case-fold-search'. If 357 there was no previous search, this function returns t." 358 (or (null pdf-isearch-current-parameter) 359 (let ((parameter (list isearch-string 360 isearch-regexp 361 isearch-case-fold-search 362 isearch-word))) 363 (if ignore-search-string-p 364 (equal (cdr pdf-isearch-current-parameter) 365 (cdr parameter)) 366 (equal pdf-isearch-current-parameter 367 parameter))))) 368 369 (defun pdf-isearch-next-match (last-page this-page last-match 370 all-matches continued-p 371 forward-p) 372 "Determine the next match." 373 (funcall (if pdf-isearch-batch-mode 374 'pdf-isearch-next-match-batch 375 'pdf-isearch-next-match-isearch) 376 last-page this-page last-match 377 all-matches continued-p forward-p)) 378 379 (defun pdf-isearch-focus-match (current-match) 380 "Make the CURRENT-MATCH visible in the window." 381 (funcall (if pdf-isearch-batch-mode 382 'pdf-isearch-focus-match-batch 383 'pdf-isearch-focus-match-isearch) 384 current-match)) 385 386 (defun pdf-isearch-redisplay () 387 "Redisplay the current highlighting." 388 (pdf-isearch-hl-matches pdf-isearch-current-match 389 pdf-isearch-current-matches)) 390 391 (defun pdf-isearch-update () 392 "Update search and redisplay, if necessary." 393 (unless (pdf-isearch-same-search-p t) 394 (setq pdf-isearch-current-parameter 395 (list isearch-string isearch-regexp 396 isearch-case-fold-search isearch-word) 397 pdf-isearch-current-matches 398 (pdf-isearch-search-page isearch-string)) 399 (pdf-isearch-redisplay))) 400 401 (defun pdf-isearch-message (fmt &rest args) 402 "Like `message', but Isearch friendly." 403 (unless args (setq args (list fmt) fmt "%s")) 404 (let ((msg (apply 'format fmt args))) 405 (if (cl-some (lambda (buf) 406 (buffer-local-value 'isearch-mode buf)) 407 (mapcar 'window-buffer (window-list))) 408 (let ((isearch-message-suffix-add 409 (format " [%s]" msg))) 410 (isearch-message) 411 (sit-for 1)) 412 (message "%s" msg)))) 413 414 (defun pdf-isearch-empty-match-p (matches) 415 (and matches 416 (cl-every 417 (lambda (match) 418 (cl-every (lambda (edges) 419 (cl-every 'zerop edges)) 420 match)) 421 matches))) 422 423 (defun pdf-isearch-occur () 424 "Run `occur' using the last search string or regexp." 425 (interactive) 426 (let ((case-fold-search isearch-case-fold-search) 427 (regexp 428 (cond 429 ((functionp isearch-word) 430 (funcall isearch-word isearch-string)) 431 (isearch-word (pdf-isearch-word-search-regexp 432 isearch-string nil 433 pdf-isearch-hyphenation-character)) 434 (isearch-regexp isearch-string)))) 435 (save-selected-window 436 (pdf-occur (or regexp isearch-string) regexp)) 437 (isearch-message))) 438 439 (defun pdf-isearch-sync-backward () 440 "Visit the source of the beginning of the current match." 441 (interactive) 442 (pdf-util-assert-pdf-window) 443 (unless pdf-isearch-current-match 444 (user-error "No current or recent match")) 445 (when isearch-mode 446 (isearch-exit)) 447 (cl-destructuring-bind (left top _right _bot) 448 (car pdf-isearch-current-match) 449 (pdf-sync-backward-search left top))) 450 451 452 ;; * ================================================================== * 453 ;; * Interface to epdfinfo 454 ;; * ================================================================== * 455 456 (defun pdf-isearch-search-page (string &optional page) 457 "Search STRING on PAGE in the current window. 458 459 Returns a list of edges (LEFT TOP RIGHT BOTTOM) in PDF 460 coordinates, sorted top to bottom, then left to right." 461 462 (unless page (setq page (pdf-view-current-page))) 463 (mapcar (lambda (match) 464 (let-alist match 465 (pdf-util-scale-relative-to-pixel .edges 'round))) 466 (let ((case-fold-search isearch-case-fold-search)) 467 (funcall (pdf-isearch-search-fun) 468 string page)))) 469 470 (defun pdf-isearch-search-fun () 471 (funcall (or pdf-isearch-search-fun-function 472 'pdf-isearch-search-fun-default))) 473 474 (defun pdf-isearch-search-fun-default () 475 "Return default functions to use for the search." 476 (cond 477 ((eq isearch-word t) 478 (lambda (string &optional pages) 479 ;; Use lax versions to not fail at the end of the word while 480 ;; the user adds and removes characters in the search string 481 ;; (or when using nonincremental word isearch) 482 (let ((lax (not (or isearch-nonincremental 483 (null (car isearch-cmds)) 484 (eq (length isearch-string) 485 (length (isearch--state-string 486 (car isearch-cmds)))))))) 487 (pdf-info-search-regexp 488 (pdf-isearch-word-search-regexp 489 string lax pdf-isearch-hyphenation-character) 490 pages 'invalid-regexp)))) 491 (isearch-regexp 492 (lambda (string &optional pages) 493 (pdf-info-search-regexp string pages 'invalid-regexp))) 494 (t 495 'pdf-info-search-string))) 496 497 498 (defun pdf-isearch-word-search-regexp (string &optional lax hyphenization-chars) 499 "Return a PCRE which matches words, ignoring punctuation." 500 (let ((hyphenization-regexp 501 (and hyphenization-chars 502 (format "(?:[%s]\\n)?" 503 (replace-regexp-in-string 504 "[]^\\\\-]" "\\\\\\&" 505 hyphenization-chars t))))) 506 (cond 507 ((equal string "") "") 508 ((string-match-p "\\`\\W+\\'" string) "\\W+") 509 (t (concat 510 (if (string-match-p "\\`\\W" string) "\\W+" 511 (unless lax "\\b")) 512 (mapconcat (lambda (word) 513 (if hyphenization-regexp 514 (mapconcat 515 (lambda (ch) 516 (pdf-util-pcre-quote (string ch))) 517 (append word nil) 518 hyphenization-regexp) 519 (pdf-util-pcre-quote word))) 520 (split-string string "\\W+" t) "\\W+") 521 (if (string-match-p "\\W\\'" string) "\\W+" 522 (unless lax "\\b"))))))) 523 524 (defun pdf-isearch-find-next-matching-page (string page &optional interactive-p) 525 "Find STRING after or before page PAGE, according to FORWARD-P. 526 527 If INTERACTIVE-P is non-nil, give some progress feedback. 528 Returns the page number where STRING was found, or nil if there 529 is no such page." 530 ;; Do a exponentially expanding search. 531 (let* ((incr 1) 532 (pages (if isearch-forward 533 (cons (1+ page) 534 (1+ page)) 535 (cons (1- page) 536 (1- page)))) 537 (fn (pdf-isearch-search-fun)) 538 matched-page 539 reporter) 540 541 (while (and (null matched-page) 542 (or (and isearch-forward 543 (<= (car pages) 544 (pdf-cache-number-of-pages))) 545 (and (not isearch-forward) 546 (>= (cdr pages) 1)))) 547 (let* ((case-fold-search isearch-case-fold-search) 548 (matches (funcall fn string pages))) 549 (setq matched-page 550 (alist-get 'page (if isearch-forward 551 (car matches) 552 (car (last matches)))))) 553 (setq incr (* incr 2)) 554 (cond (isearch-forward 555 (setcar pages (1+ (cdr pages))) 556 (setcdr pages (min (pdf-cache-number-of-pages) 557 (+ (cdr pages) incr)))) 558 (t 559 (setcdr pages (1- (car pages))) 560 (setcar pages (max 1 (- (car pages) 561 incr))))) 562 (when interactive-p 563 (when (and (not reporter) 564 (= incr 8)) ;;Don't bother right away. 565 (setq reporter 566 (apply 567 'make-progress-reporter "Searching" 568 (if isearch-forward 569 (list (car pages) (pdf-cache-number-of-pages) nil 0) 570 (list 1 (cdr pages) nil 0))))) 571 (when reporter 572 (progress-reporter-update 573 reporter (if isearch-forward 574 (- (cdr pages) page) 575 (- page (car pages))))))) 576 matched-page)) 577 578 579 580 ;; * ================================================================== * 581 ;; * Isearch Behavior 582 ;; * ================================================================== * 583 584 (defun pdf-isearch-next-match-isearch (last-page this-page last-match 585 matches same-search-p 586 forward) 587 "Default function for choosing the next match. 588 589 Implements default isearch behaviour, i.e. it stops at every 590 match." 591 (cond 592 ((null last-match) 593 ;; Goto first match from top or bottom of the window. 594 (let* ((iedges (pdf-util-image-displayed-edges)) 595 (pos (pdf-util-with-edges (iedges) 596 (if forward 597 (list iedges-left iedges-top 598 iedges-left iedges-top) 599 (list iedges-right iedges-bot 600 iedges-right iedges-bot))))) 601 (pdf-isearch-closest-match (list pos) matches forward))) 602 ((not (eq last-page this-page)) 603 ;; First match from top-left or bottom-right of the new 604 ;; page. 605 (car matches)) 606 (same-search-p 607 ;; Next match after the last one. 608 (if last-match 609 (cadr (member last-match matches)))) 610 (matches 611 ;; Next match of new search closest to the last one. 612 (pdf-isearch-closest-match 613 last-match matches forward)))) 614 615 (defun pdf-isearch-focus-match-isearch (match) 616 "Make the image area in MATCH visible in the selected window." 617 (pdf-util-scroll-to-edges (apply 'pdf-util-edges-union match))) 618 619 (defun pdf-isearch-next-match-batch (last-page this-page last-match 620 matches same-search-p 621 forward-p) 622 "Select the next match, unseen in the current search direction." 623 624 (if (or (null last-match) 625 (not same-search-p) 626 (not (eq last-page this-page))) 627 (pdf-isearch-next-match-isearch 628 last-page this-page last-match matches same-search-p forward-p) 629 (pdf-util-with-edges (match iedges) 630 (let ((iedges (pdf-util-image-displayed-edges))) 631 (car (cl-remove-if 632 ;; Filter matches visible on screen. 633 (lambda (edges) 634 (let ((match (apply 'pdf-util-edges-union edges))) 635 (and (<= match-right iedges-right) 636 (<= match-bot iedges-bot) 637 (>= match-left iedges-left) 638 (>= match-top iedges-top)))) 639 (cdr (member last-match matches)))))))) 640 641 (defun pdf-isearch-focus-match-batch (match) 642 "Make the image area in MATCH eagerly visible in the selected window." 643 (pdf-util-scroll-to-edges (apply 'pdf-util-edges-union match) t)) 644 645 (cl-deftype pdf-isearch-match () 646 `(satisfies 647 (lambda (match) 648 (cl-every (lambda (edges) 649 (and (consp edges) 650 (= (length edges) 4) 651 (cl-every 'numberp edges))) 652 match)))) 653 654 (cl-deftype list-of (type) 655 `(satisfies 656 (lambda (l) 657 (and (listp l) 658 (cl-every (lambda (x) 659 (cl-typep x ',type)) 660 l))))) 661 662 (defun pdf-isearch-closest-match (match matches 663 &optional forward-p) 664 "Find the nearest element to MATCH in MATCHES. 665 666 The direction in which to look is determined by FORWARD-P. 667 668 MATCH should be a list of edges, MATCHES a list of such element; 669 it is assumed to be ordered with respect to FORWARD-P." 670 671 672 (cl-check-type match pdf-isearch-match) 673 (cl-check-type matches (list-of pdf-isearch-match)) 674 (let ((matched (apply 'pdf-util-edges-union match))) 675 (pdf-util-with-edges (matched) 676 (cl-loop for next in matches do 677 (let ((edges (apply 'pdf-util-edges-union next))) 678 (pdf-util-with-edges (edges) 679 (when (if forward-p 680 (or (>= edges-top matched-bot) 681 (and (or (>= edges-top matched-top) 682 (>= edges-bot matched-bot)) 683 (>= edges-right matched-right))) 684 (or (<= edges-bot matched-top) 685 (and (or (<= edges-bot matched-bot) 686 (<= edges-top matched-top)) 687 (<= edges-left matched-left)))) 688 (cl-return next)))))))) 689 690 691 692 ;; * ================================================================== * 693 ;; * Display 694 ;; * ================================================================== * 695 696 697 (defun pdf-isearch-current-colors () 698 "Return the current color set. 699 700 The return value depends on `pdf-view-dark-minor-mode' and 701 `pdf-isearch-batch-mode'. It is a list of four colors \(MATCH-FG 702 MATCH-BG LAZY-FG LAZY-BG\)." 703 (let ((dark-p pdf-view-dark-minor-mode)) 704 (cond 705 (pdf-isearch-batch-mode 706 (let ((colors (pdf-util-face-colors 'pdf-isearch-batch dark-p))) 707 (list (car colors) 708 (cdr colors) 709 (car colors) 710 (cdr colors)))) 711 (t 712 (let ((match (pdf-util-face-colors 'pdf-isearch-match dark-p)) 713 (lazy (pdf-util-face-colors 'pdf-isearch-lazy dark-p))) 714 (list (car match) 715 (cdr match) 716 (car lazy) 717 (cdr lazy))))))) 718 719 (defvar pdf-isearch--hl-matches-tick 0) 720 721 (defun pdf-isearch-hl-matches (current matches &optional occur-hack-p) 722 "Highlighting edges CURRENT and MATCHES." 723 (cl-check-type current pdf-isearch-match) 724 (cl-check-type matches (list-of pdf-isearch-match)) 725 (cl-destructuring-bind (fg1 bg1 fg2 bg2) 726 (pdf-isearch-current-colors) 727 (let* ((width (car (pdf-view-image-size))) 728 (page (pdf-view-current-page)) 729 (window (selected-window)) 730 (buffer (current-buffer)) 731 (tick (cl-incf pdf-isearch--hl-matches-tick)) 732 (pdf-info-asynchronous 733 (lambda (status data) 734 (when (and (null status) 735 (eq tick pdf-isearch--hl-matches-tick) 736 (buffer-live-p buffer) 737 (window-live-p window) 738 (eq (window-buffer window) 739 buffer)) 740 (with-selected-window window 741 (when (and (derived-mode-p 'pdf-view-mode) 742 (or isearch-mode 743 occur-hack-p) 744 (eq page (pdf-view-current-page))) 745 (pdf-view-display-image 746 (pdf-view-create-image data :width width)))))))) 747 (pdf-info-renderpage-text-regions 748 page width t nil nil 749 `(,fg1 ,bg1 ,@(pdf-util-scale-pixel-to-relative 750 current)) 751 `(,fg2 ,bg2 ,@(pdf-util-scale-pixel-to-relative 752 (apply 'append 753 (remove current matches)))))))) 754 755 756 ;; * ================================================================== * 757 ;; * Debug 758 ;; * ================================================================== * 759 760 ;; The following isearch-search function is debuggable. 761 ;; 762 (when nil 763 (defun isearch-search () 764 ;; Do the search with the current search string. 765 (if isearch-message-function 766 (funcall isearch-message-function nil t) 767 (isearch-message nil t)) 768 (if (and (eq isearch-case-fold-search t) search-upper-case) 769 (setq isearch-case-fold-search 770 (isearch-no-upper-case-p isearch-string isearch-regexp))) 771 (condition-case lossage 772 (let ((inhibit-point-motion-hooks 773 ;; FIXME: equality comparisons on functions is asking for trouble. 774 (and (eq isearch-filter-predicate 'isearch-filter-visible) 775 search-invisible)) 776 (inhibit-quit nil) 777 (case-fold-search isearch-case-fold-search) 778 (retry t)) 779 (setq isearch-error nil) 780 (while retry 781 (setq isearch-success 782 (isearch-search-string isearch-string nil t)) 783 ;; Clear RETRY unless the search predicate says 784 ;; to skip this search hit. 785 (if (or (not isearch-success) 786 (bobp) (eobp) 787 (= (match-beginning 0) (match-end 0)) 788 (funcall isearch-filter-predicate 789 (match-beginning 0) (match-end 0))) 790 (setq retry nil))) 791 (setq isearch-just-started nil) 792 (if isearch-success 793 (setq isearch-other-end 794 (if isearch-forward (match-beginning 0) (match-end 0))))) 795 796 (quit (isearch-unread ?\C-g) 797 (setq isearch-success nil)) 798 799 (invalid-regexp 800 (setq isearch-error (car (cdr lossage))) 801 (if (string-match 802 "\\`Premature \\|\\`Unmatched \\|\\`Invalid " 803 isearch-error) 804 (setq isearch-error "incomplete input"))) 805 806 (search-failed 807 (setq isearch-success nil) 808 (setq isearch-error (nth 2 lossage))) 809 810 ;; (error 811 ;; ;; stack overflow in regexp search. 812 ;; (setq isearch-error (format "%s" lossage))) 813 ) 814 815 (if isearch-success 816 nil 817 ;; Ding if failed this time after succeeding last time. 818 (and (isearch--state-success (car isearch-cmds)) 819 (ding)) 820 (if (functionp (isearch--state-pop-fun (car isearch-cmds))) 821 (funcall (isearch--state-pop-fun (car isearch-cmds)) 822 (car isearch-cmds))) 823 (goto-char (isearch--state-point (car isearch-cmds)))))) 824 825 826 (provide 'pdf-isearch) 827 828 ;;; pdf-isearch.el ends here 829 830 ;; Local Variables: 831 ;; byte-compile-warnings: (not obsolete) 832 ;; End: