Klimi's new dotfiles with stow.
Du kannst nicht mehr als 25 Themen auswählen Themen müssen entweder mit einem Buchstaben oder einer Ziffer beginnen. Sie können Bindestriche („-“) enthalten und bis zu 35 Zeichen lang sein.

826 Zeilen
30 KiB

vor 5 Jahren
  1. ;;; pdf-occur.el --- Display matching lines of PDF documents. -*- lexical-binding: t -*-
  2. ;; Copyright (C) 2013, 2014 Andreas Politz
  3. ;; Author: Andreas Politz <politza@fh-trier.de>
  4. ;; Keywords: files, multimedia
  5. ;; This program is free software; you can redistribute it and/or modify
  6. ;; it under the terms of the GNU General Public License as published by
  7. ;; the Free Software Foundation, either version 3 of the License, or
  8. ;; (at your option) any later version.
  9. ;; This program is distributed in the hope that it will be useful,
  10. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. ;; GNU General Public License for more details.
  13. ;; You should have received a copy of the GNU General Public License
  14. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  15. ;;; Commentary:
  16. ;;
  17. (require 'pdf-tools)
  18. (require 'pdf-view)
  19. (require 'pdf-util)
  20. (require 'pdf-info)
  21. (require 'pdf-isearch)
  22. (require 'tablist)
  23. (require 'ibuf-ext)
  24. (require 'dired)
  25. (require 'let-alist)
  26. ;;; Code:
  27. ;; * ================================================================== *
  28. ;; * Custom & Variables
  29. ;; * ================================================================== *
  30. (defgroup pdf-occur nil
  31. "Display matching lines of PDF documents."
  32. :group 'pdf-tools)
  33. (defface pdf-occur-document-face
  34. '((default (:inherit font-lock-string-face)))
  35. "Face used to highlight documents in the list buffer."
  36. :group 'pdf-occur)
  37. (defface pdf-occur-page-face
  38. '((default (:inherit font-lock-type-face)))
  39. "Face used to highlight page numbers in the list buffer."
  40. :group 'pdf-occur)
  41. (defcustom pdf-occur-search-batch-size 16
  42. "Maximum number of pages searched in one query.
  43. Lower numbers will make Emacs more responsive when searching at
  44. the cost of slightly increased search time."
  45. :group 'pdf-occur
  46. :type 'integer)
  47. (defcustom pdf-occur-prefer-string-search nil
  48. "If non-nil, reverse the meaning of the regexp-p prefix-arg."
  49. :group 'pdf-occur
  50. :type 'boolean)
  51. (defvar pdf-occur-history nil
  52. "The history variable for search strings.")
  53. (defvar pdf-occur-search-pages-left nil
  54. "The total number of pages left to search.")
  55. (defvar pdf-occur-search-documents nil
  56. "The list of searched documents.
  57. Each element should be either the filename of a PDF document or a
  58. cons \(FILENAME . PAGES\), where PAGES is the list of pages to
  59. search. See `pdf-info-normalize-page-range' for it's format.")
  60. (defvar pdf-occur-number-of-matches 0
  61. "The number of matches in all searched documents.")
  62. (defvar pdf-occur-search-string nil
  63. "The currently used search string, resp. regexp.")
  64. (defvar pdf-occur-search-regexp-p nil
  65. "Non-nil, if searching for a regexp.")
  66. (defvar pdf-occur-buffer-mode-map
  67. (let ((kmap (make-sparse-keymap)))
  68. (set-keymap-parent kmap tablist-mode-map)
  69. (define-key kmap (kbd "RET") 'pdf-occur-goto-occurrence)
  70. (define-key kmap (kbd "C-o") 'pdf-occur-view-occurrence)
  71. (define-key kmap (kbd "SPC") 'pdf-occur-view-occurrence)
  72. (define-key kmap (kbd "C-c C-f") 'next-error-follow-minor-mode)
  73. (define-key kmap (kbd "g") 'pdf-occur-revert-buffer-with-args)
  74. (define-key kmap (kbd "K") 'pdf-occur-abort-search)
  75. (define-key kmap (kbd "D") 'pdf-occur-tablist-do-delete)
  76. (define-key kmap (kbd "x") 'pdf-occur-tablist-do-flagged-delete)
  77. (define-key kmap (kbd "A") 'pdf-occur-tablist-gather-documents)
  78. kmap)
  79. "The keymap used for `pdf-occur-buffer-mode'.")
  80. ;; * ================================================================== *
  81. ;; * High level functions
  82. ;; * ================================================================== *
  83. (define-derived-mode pdf-occur-buffer-mode tablist-mode "PDFOccur"
  84. "Major mode for output from `pdf-occur`. \\<pdf-occur-buffer-mode-map>
  85. Some useful keys are:
  86. \\[pdf-occur-abort-search] - Abort the search.
  87. \\[pdf-occur-revert-buffer-with-args] - Restart the search.
  88. \\[universal-argument] \\[pdf-occur-revert-buffer-with-args] - Restart search with different regexp.
  89. \\[universal-argument] \\[universal-argument] \\[pdf-occur-revert-buffer-with-args] - Same, but do a plain string search.
  90. \\[tablist-push-regexp-filter] - Filter matches by regexp on current or prefix-th column.
  91. \\[tablist-pop-filter] - Remove last added filter.
  92. \\[pdf-occur-tablist-do-delete] - Remove the current file from the search.
  93. \\[pdf-occur-tablist-gather-documents] - Include marked files from displayed `dired'/`ibuffer' and
  94. `pdf-view-mode' buffers in the search.
  95. \\{pdf-occur-buffer-mode-map}"
  96. (setq-local next-error-function 'pdf-occur-next-error)
  97. (setq-local revert-buffer-function
  98. 'pdf-occur-revert-buffer)
  99. (setq next-error-last-buffer (current-buffer))
  100. (setq-local tabulated-list-sort-key nil)
  101. (setq-local tabulated-list-use-header-line t)
  102. (setq-local tablist-operations-function
  103. (lambda (op &rest _)
  104. (cl-case op
  105. (supported-operations '(find-entry))
  106. (find-entry
  107. (let ((display-buffer-overriding-action
  108. '(display-buffer-same-window)))
  109. (pdf-occur-goto-occurrence)))))))
  110. ;;;###autoload
  111. (defun pdf-occur (string &optional regexp-p)
  112. "List lines matching STRING or PCRE.
  113. Interactively search for a regexp. Unless a prefix arg was given,
  114. in which case this functions performs a string search.
  115. If `pdf-occur-prefer-string-search' is non-nil, the meaning of
  116. the prefix-arg is inverted."
  117. (interactive
  118. (progn
  119. (pdf-util-assert-pdf-buffer)
  120. (list
  121. (pdf-occur-read-string
  122. (pdf-occur-want-regexp-search-p))
  123. (pdf-occur-want-regexp-search-p))))
  124. (pdf-util-assert-pdf-buffer)
  125. (pdf-occur-search (list (current-buffer)) string regexp-p))
  126. (defvar ibuffer-filtering-qualifiers)
  127. ;;;###autoload
  128. (defun pdf-occur-multi-command ()
  129. "Perform `pdf-occur' on multiple buffer.
  130. For a programmatic search of multiple documents see
  131. `pdf-occur-search'."
  132. (interactive)
  133. (ibuffer)
  134. (with-current-buffer "*Ibuffer*"
  135. (pdf-occur-ibuffer-minor-mode)
  136. (unless (member '(derived-mode . pdf-view-mode)
  137. ibuffer-filtering-qualifiers)
  138. (ibuffer-filter-by-derived-mode 'pdf-view-mode))
  139. (message
  140. "%s"
  141. (substitute-command-keys
  142. "Mark a bunch of PDF buffers and type \\[pdf-occur-ibuffer-do-occur]"))
  143. (sit-for 3)))
  144. (defun pdf-occur-revert-buffer (&rest _)
  145. "Restart the search."
  146. (pdf-occur-assert-occur-buffer-p)
  147. (unless pdf-occur-search-documents
  148. (error "No documents to search"))
  149. (unless pdf-occur-search-string
  150. (error "Nothing to search for"))
  151. (let* ((2-columns-p (= 1 (length pdf-occur-search-documents)))
  152. (filename-width
  153. (min 24
  154. (apply 'max
  155. (mapcar 'length
  156. (mapcar 'pdf-occur-abbrev-document
  157. (mapcar 'car pdf-occur-search-documents))))))
  158. (page-sorter (tablist-generate-sorter
  159. (if 2-columns-p 0 1)
  160. '<
  161. 'string-to-number)))
  162. (setq tabulated-list-format
  163. (if 2-columns-p
  164. `[("Page" 4 ,page-sorter :right-align t)
  165. ("Line" 0 t)]
  166. `[("Document" ,filename-width t)
  167. ("Page" 4 ,page-sorter :right-align t)
  168. ("Line" 0 t)])
  169. tabulated-list-entries nil))
  170. (tabulated-list-revert)
  171. (pdf-occur-start-search
  172. pdf-occur-search-documents
  173. pdf-occur-search-string
  174. pdf-occur-search-regexp-p)
  175. (pdf-occur-update-header-line)
  176. (setq mode-line-process
  177. '(:propertize ":run" face compilation-mode-line-run)))
  178. (defun pdf-occur-revert-buffer-with-args (string &optional regexp-p documents)
  179. "Restart the search with modified arguments.
  180. Interactively just restart the search, unless a prefix was given.
  181. In this case read a new search string. With `C-u C-u' as prefix
  182. additionally invert the current state of
  183. `pdf-occur-search-regexp-p'."
  184. (interactive
  185. (progn
  186. (pdf-occur-assert-occur-buffer-p)
  187. (cond
  188. (current-prefix-arg
  189. (let ((regexp-p
  190. (if (equal current-prefix-arg '(16))
  191. (not pdf-occur-search-regexp-p)
  192. pdf-occur-search-regexp-p)))
  193. (list
  194. (pdf-occur-read-string regexp-p)
  195. regexp-p)))
  196. (t
  197. (list pdf-occur-search-string
  198. pdf-occur-search-regexp-p)))))
  199. (setq pdf-occur-search-string string
  200. pdf-occur-search-regexp-p regexp-p)
  201. (when documents
  202. (setq pdf-occur-search-documents
  203. (pdf-occur-normalize-documents documents)))
  204. (pdf-occur-revert-buffer))
  205. (defun pdf-occur-abort-search ()
  206. "Abort the current search.
  207. This immediately kills the search process."
  208. (interactive)
  209. (unless (pdf-occur-search-in-progress-p)
  210. (user-error "No search in progress"))
  211. (pdf-info-kill-local-server)
  212. (pdf-occur-search-finished t))
  213. ;; * ================================================================== *
  214. ;; * Finding occurrences
  215. ;; * ================================================================== *
  216. (defun pdf-occur-goto-occurrence (&optional no-select-window-p)
  217. "Go to the occurrence at point.
  218. If EVENT is nil, use occurrence at current line. Select the
  219. PDF's window, unless NO-SELECT-WINDOW-P is non-nil.
  220. FIXME: EVENT not used at the moment."
  221. (interactive)
  222. (let ((item (tabulated-list-get-id)))
  223. (when item
  224. (let* ((doc (plist-get item :document))
  225. (page (plist-get item :page))
  226. (match (plist-get item :match-edges))
  227. (buffer (if (bufferp doc)
  228. doc
  229. (or (find-buffer-visiting doc)
  230. (find-file-noselect doc))))
  231. window)
  232. (if no-select-window-p
  233. (setq window (display-buffer buffer))
  234. (pop-to-buffer buffer)
  235. (setq window (selected-window)))
  236. (with-selected-window window
  237. (when page
  238. (pdf-view-goto-page page))
  239. ;; Abuse isearch.
  240. (when match
  241. (let ((pixel-match
  242. (pdf-util-scale-relative-to-pixel match))
  243. (pdf-isearch-batch-mode t))
  244. (pdf-isearch-hl-matches pixel-match nil t)
  245. (pdf-isearch-focus-match-batch pixel-match))))))))
  246. (defun pdf-occur-view-occurrence (&optional _event)
  247. "View the occurrence at EVENT.
  248. If EVENT is nil, use occurrence at current line."
  249. (interactive (list last-nonmenu-event))
  250. (pdf-occur-goto-occurrence t))
  251. (defun pdf-occur-next-error (&optional arg reset)
  252. "Move to the Nth (default 1) next match in an PDF Occur mode buffer.
  253. Compatibility function for \\[next-error] invocations."
  254. (interactive "p")
  255. ;; we need to run pdf-occur-find-match from within the Occur buffer
  256. (with-current-buffer
  257. ;; Choose the buffer and make it current.
  258. (if (next-error-buffer-p (current-buffer))
  259. (current-buffer)
  260. (next-error-find-buffer
  261. nil nil
  262. (lambda ()
  263. (eq major-mode 'pdf-occur-buffer-mode))))
  264. (when (bobp)
  265. (setq reset t))
  266. (if reset
  267. (goto-char (point-min))
  268. (beginning-of-line))
  269. (when (/= arg 0)
  270. (when (eobp)
  271. (forward-line -1))
  272. (when reset
  273. (cl-decf arg))
  274. (let ((line (line-number-at-pos))
  275. (limit (line-number-at-pos
  276. (if (>= arg 0)
  277. (1- (point-max))
  278. (point-min)))))
  279. (when (= line limit)
  280. (error "No more matches"))
  281. (forward-line
  282. (if (>= arg 0)
  283. (min arg (- limit line))
  284. (max arg (- limit line))))))
  285. ;; In case the *Occur* buffer is visible in a nonselected window.
  286. (tablist-move-to-major-column)
  287. (let ((win (get-buffer-window (current-buffer) t)))
  288. (if win (set-window-point win (point))))
  289. (pdf-occur-goto-occurrence)))
  290. ;; * ================================================================== *
  291. ;; * Integration with other modes
  292. ;; * ================================================================== *
  293. ;;;###autoload
  294. (define-minor-mode pdf-occur-global-minor-mode
  295. "Enable integration of Pdf Occur with other modes.
  296. This global minor mode enables (or disables)
  297. `pdf-occur-ibuffer-minor-mode' and `pdf-occur-dired-minor-mode'
  298. in all current and future ibuffer/dired buffer." nil nil nil
  299. :global t
  300. (let ((arg (if pdf-occur-global-minor-mode 1 -1)))
  301. (dolist (buf (buffer-list))
  302. (with-current-buffer buf
  303. (cond
  304. ((derived-mode-p 'dired-mode)
  305. (pdf-occur-dired-minor-mode arg))
  306. ((derived-mode-p 'ibuffer-mode)
  307. (pdf-occur-ibuffer-minor-mode arg)))))
  308. (cond
  309. (pdf-occur-global-minor-mode
  310. (add-hook 'dired-mode-hook 'pdf-occur-dired-minor-mode)
  311. (add-hook 'ibuffer-mode-hook 'pdf-occur-ibuffer-minor-mode))
  312. (t
  313. (remove-hook 'dired-mode-hook 'pdf-occur-dired-minor-mode)
  314. (remove-hook 'ibuffer-mode-hook 'pdf-occur-ibuffer-minor-mode)))))
  315. (defvar pdf-occur-ibuffer-minor-mode-map
  316. (let ((map (make-sparse-keymap)))
  317. (define-key map [remap ibuffer-do-occur] 'pdf-occur-ibuffer-do-occur)
  318. map)
  319. "Keymap used in `pdf-occur-ibuffer-minor-mode'.")
  320. ;;;###autoload
  321. (define-minor-mode pdf-occur-ibuffer-minor-mode
  322. "Hack into ibuffer's do-occur binding.
  323. This mode remaps `ibuffer-do-occur' to
  324. `pdf-occur-ibuffer-do-occur', which will start the PDF Tools
  325. version of `occur', if all marked buffer's are in `pdf-view-mode'
  326. and otherwise fallback to `ibuffer-do-occur'."
  327. nil nil nil)
  328. (defun pdf-occur-ibuffer-do-occur (&optional regexp-p)
  329. "Uses `pdf-occur-search', if appropriate.
  330. I.e. all marked buffers are in PDFView mode."
  331. (interactive
  332. (list (pdf-occur-want-regexp-search-p)))
  333. (let* ((buffer (or (ibuffer-get-marked-buffers)
  334. (and (ibuffer-current-buffer)
  335. (list (ibuffer-current-buffer)))))
  336. (pdf-only-p (cl-every
  337. (lambda (buf)
  338. (with-current-buffer buf
  339. (derived-mode-p 'pdf-view-mode)))
  340. buffer)))
  341. (if (not pdf-only-p)
  342. (call-interactively 'ibuffer-do-occur)
  343. (let ((regexp (pdf-occur-read-string regexp-p)))
  344. (pdf-occur-search buffer regexp regexp-p)))))
  345. (defvar pdf-occur-dired-minor-mode-map
  346. (let ((map (make-sparse-keymap)))
  347. (define-key map [remap dired-do-search] 'pdf-occur-dired-do-search)
  348. map)
  349. "Keymap used in `pdf-occur-dired-minor-mode'.")
  350. ;;;###autoload
  351. (define-minor-mode pdf-occur-dired-minor-mode
  352. "Hack into dired's `dired-do-search' binding.
  353. This mode remaps `dired-do-search' to
  354. `pdf-occur-dired-do-search', which will start the PDF Tools
  355. version of `occur', if all marked buffer's are in `pdf-view-mode'
  356. and otherwise fallback to `dired-do-search'."
  357. nil nil nil)
  358. (defun pdf-occur-dired-do-search ()
  359. "Uses `pdf-occur-search', if appropriate.
  360. I.e. all marked files look like PDF documents."
  361. (interactive)
  362. (let ((files (dired-get-marked-files)))
  363. (if (not (cl-every (lambda (file)
  364. (string-match-p
  365. (car pdf-tools-auto-mode-alist-entry)
  366. file))
  367. files))
  368. (call-interactively 'dired-do-search)
  369. (let* ((regex-p (pdf-occur-want-regexp-search-p))
  370. (regexp (pdf-occur-read-string regex-p)))
  371. (pdf-occur-search files regexp regex-p)))))
  372. ;; * ================================================================== *
  373. ;; * Search engine
  374. ;; * ================================================================== *
  375. (defun pdf-occur-search (documents string &optional regexp-p)
  376. "Search DOCUMENTS for STRING.
  377. DOCUMENTS should be a list of buffers (objects, not names),
  378. filenames or conses \(BUFFER-OR-FILENAME . PAGES\), where PAGES
  379. determines the scope of the search of the respective document.
  380. See `pdf-info-normalize-page-range' for it's format.
  381. STRING is either the string to search for or, if REGEXP-P is
  382. non-nil, a Perl compatible regular expression (PCRE).
  383. Display the occur buffer and start the search asynchronously.
  384. Returns the window where the buffer is displayed."
  385. (unless documents
  386. (error "No documents to search"))
  387. (when (or (null string) (= (length string) 0))
  388. (error "Not searching for the empty string"))
  389. (with-current-buffer (get-buffer-create "*PDF-Occur*")
  390. (pdf-occur-buffer-mode)
  391. (setq-local pdf-occur-search-documents
  392. (pdf-occur-normalize-documents documents))
  393. (setq-local pdf-occur-search-string string)
  394. (setq-local pdf-occur-search-regexp-p regexp-p)
  395. (setq-local pdf-occur-search-pages-left 0)
  396. (setq-local pdf-occur-number-of-matches 0)
  397. (pdf-occur-revert-buffer)
  398. (display-buffer
  399. (current-buffer))))
  400. (defadvice tabulated-list-init-header (after update-header activate)
  401. "We want our own headers, thank you."
  402. (when (derived-mode-p 'pdf-occur-buffer-mode)
  403. (save-current-buffer
  404. (with-no-warnings (pdf-occur-update-header-line)))))
  405. (defun pdf-occur-create-entry (filename page &optional match)
  406. "Create a `tabulated-list-entries' entry for a search result.
  407. If match is nil, create a fake entry for documents w/o any
  408. matches linked with PAGE."
  409. (let* ((text (or (car match) "[No matches]"))
  410. (edges (cdr match))
  411. (displayed-text
  412. (if match
  413. (replace-regexp-in-string "\n" "\\n" text t t)
  414. (propertize text 'face 'font-lock-warning-face)))
  415. (displayed-page
  416. (if match
  417. (propertize (format "%d" page)
  418. 'face 'pdf-occur-page-face)
  419. ""))
  420. (displayed-document
  421. (propertize
  422. (pdf-occur-abbrev-document filename)
  423. 'face 'pdf-occur-document-face))
  424. (id `(:document ,filename
  425. :page ,page
  426. :match-text ,(if match text)
  427. :match-edges ,(if match edges))))
  428. (list id
  429. (if (= (length pdf-occur-search-documents) 1)
  430. (vector displayed-page displayed-text)
  431. (vector displayed-document
  432. displayed-page
  433. displayed-text)))))
  434. (defun pdf-occur-update-header-line ()
  435. (pdf-occur-assert-occur-buffer-p)
  436. (save-current-buffer
  437. ;;force-mode-line-update seems to sometimes spuriously change the
  438. ;;current buffer.
  439. (setq header-line-format
  440. `(:eval (concat
  441. (if (= (length pdf-occur-search-documents) 1)
  442. (format "%d match%s in document `%s'"
  443. pdf-occur-number-of-matches
  444. (if (/= 1 pdf-occur-number-of-matches) "es" "")
  445. (pdf-occur-abbrev-document
  446. (caar pdf-occur-search-documents)))
  447. (format "%d match%s in %d documents"
  448. pdf-occur-number-of-matches
  449. (if (/= 1 pdf-occur-number-of-matches) "es" "")
  450. (length pdf-occur-search-documents)))
  451. (if (pdf-occur-search-in-progress-p)
  452. (propertize
  453. (concat " ["
  454. (if (numberp pdf-occur-search-pages-left)
  455. (format "%d pages left"
  456. pdf-occur-search-pages-left)
  457. "Searching")
  458. "]")
  459. 'face 'compilation-mode-line-run)))))
  460. (force-mode-line-update)))
  461. (defun pdf-occur-search-finished (&optional abort-p)
  462. (setq pdf-occur-search-pages-left 0)
  463. (setq mode-line-process
  464. (if abort-p
  465. '(:propertize
  466. ":aborted" face compilation-mode-line-fail)
  467. '(:propertize
  468. ":exit" face compilation-mode-line-exit)))
  469. (let ((unmatched
  470. (mapcar (lambda (doc)
  471. (pdf-occur-create-entry doc 1))
  472. (cl-set-difference
  473. (mapcar 'car
  474. pdf-occur-search-documents)
  475. (mapcar (lambda (elt)
  476. (plist-get (car elt) :document))
  477. tabulated-list-entries)
  478. :test 'equal))))
  479. (when (and unmatched
  480. (> (length pdf-occur-search-documents) 1))
  481. (pdf-occur-insert-entries unmatched)))
  482. (tablist-apply-filter)
  483. (pdf-occur-update-header-line)
  484. (pdf-isearch-message
  485. (if abort-p
  486. "Search aborted."
  487. (format "Occur search finished with %d matches"
  488. pdf-occur-number-of-matches))))
  489. (defun pdf-occur-add-matches (filename matches)
  490. (pdf-occur-assert-occur-buffer-p)
  491. (when matches
  492. (let (entries)
  493. (dolist (match matches)
  494. (let-alist match
  495. (push (pdf-occur-create-entry filename .page (cons .text .edges))
  496. entries)))
  497. (setq entries (nreverse entries))
  498. (pdf-occur-insert-entries entries))))
  499. (defun pdf-occur-insert-entries (entries)
  500. "Insert tabulated-list ENTRIES at the end."
  501. (pdf-occur-assert-occur-buffer-p)
  502. (let ((inhibit-read-only t)
  503. (end-of-buffer (and (eobp) (not (bobp)))))
  504. (save-excursion
  505. (goto-char (point-max))
  506. (dolist (elt entries)
  507. (apply tabulated-list-printer elt))
  508. (set-buffer-modified-p nil))
  509. (when end-of-buffer
  510. (dolist (win (get-buffer-window-list))
  511. (set-window-point win (point-max))))
  512. (setq tabulated-list-entries
  513. (append tabulated-list-entries
  514. entries))))
  515. (defun pdf-occur-search-in-progress-p ()
  516. (and (numberp pdf-occur-search-pages-left)
  517. (> pdf-occur-search-pages-left 0)))
  518. (defun pdf-occur-start-search (documents string
  519. &optional regexp-p)
  520. (pdf-occur-assert-occur-buffer-p)
  521. (pdf-info-make-local-server nil t)
  522. (let ((batches (pdf-occur-create-batches
  523. documents (or pdf-occur-search-batch-size 1))))
  524. (pdf-info-local-batch-query
  525. (lambda (document pages)
  526. (if regexp-p
  527. (pdf-info-search-regexp string pages nil document)
  528. (pdf-info-search-string string pages document)))
  529. (lambda (status response document pages)
  530. (if status
  531. (error "%s" response)
  532. (when (numberp pdf-occur-search-pages-left)
  533. (cl-decf pdf-occur-search-pages-left
  534. (1+ (- (cdr pages) (car pages)))))
  535. (when (cl-member document pdf-occur-search-documents
  536. :key 'car
  537. :test 'equal)
  538. (cl-incf pdf-occur-number-of-matches
  539. (length response))
  540. (pdf-occur-add-matches document response)
  541. (pdf-occur-update-header-line))))
  542. (lambda (status buffer)
  543. (when (buffer-live-p buffer)
  544. (with-current-buffer buffer
  545. (pdf-occur-search-finished (eq status 'killed)))))
  546. batches)
  547. (setq pdf-occur-number-of-matches 0)
  548. (setq pdf-occur-search-pages-left
  549. (apply '+ (mapcar (lambda (elt)
  550. (1+ (- (cdr (nth 1 elt))
  551. (car (nth 1 elt)))))
  552. batches)))))
  553. ;; * ================================================================== *
  554. ;; * Editing searched documents
  555. ;; * ================================================================== *
  556. (defun pdf-occur-tablist-do-delete (&optional arg)
  557. "Delete ARG documents from the search list."
  558. (interactive "P")
  559. (when (pdf-occur-search-in-progress-p)
  560. (user-error "Can't delete while a search is in progress."))
  561. (let* ((items (tablist-get-marked-items arg))
  562. (documents (cl-remove-duplicates
  563. (mapcar (lambda (entry)
  564. (plist-get (car entry) :document))
  565. items)
  566. :test 'equal)))
  567. (unless documents
  568. (error "No documents selected"))
  569. (when (tablist-yes-or-no-p
  570. 'Stop\ searching
  571. nil (mapcar (lambda (d) (cons nil (vector d)))
  572. documents))
  573. (setq pdf-occur-search-documents
  574. (cl-remove-if (lambda (elt)
  575. (member (car elt) documents))
  576. pdf-occur-search-documents)
  577. tabulated-list-entries
  578. (cl-remove-if (lambda (elt)
  579. (when (member (plist-get (car elt) :document)
  580. documents)
  581. (when (plist-get (car elt) :match-edges)
  582. (cl-decf pdf-occur-number-of-matches))
  583. t))
  584. tabulated-list-entries))
  585. (tablist-revert)
  586. (pdf-occur-update-header-line)
  587. (tablist-move-to-major-column))))
  588. (defun pdf-occur-tablist-do-flagged-delete (&optional interactive)
  589. "Stop searching all documents marked with a D."
  590. (interactive "p")
  591. (let* ((tablist-marker-char ?D))
  592. (if (save-excursion
  593. (goto-char (point-min))
  594. (re-search-forward (tablist-marker-regexp) nil t))
  595. (pdf-occur-tablist-do-delete)
  596. (or (not interactive)
  597. (message "(No deletions requested)")))))
  598. (defun pdf-occur-tablist-gather-documents ()
  599. "Gather marked documents in windows.
  600. Examine all dired/ibuffer windows and offer to put marked files
  601. in the search list."
  602. (interactive)
  603. (let ((searched (mapcar 'car pdf-occur-search-documents))
  604. files)
  605. (dolist (win (window-list))
  606. (with-selected-window win
  607. (cond
  608. ((derived-mode-p 'dired-mode)
  609. (let ((marked (dired-get-marked-files nil nil nil t)))
  610. (when (> (length marked) 1)
  611. (when (eq t (car marked))
  612. (setq marked (cdr marked)))
  613. (setq files
  614. (append files marked nil)))))
  615. ((derived-mode-p 'ibuffer-mode)
  616. (dolist (fname (mapcar 'buffer-file-name
  617. (ibuffer-get-marked-buffers)))
  618. (when fname
  619. (push fname files))))
  620. ((and (derived-mode-p 'pdf-view-mode)
  621. (buffer-file-name))
  622. (push (buffer-file-name) files)))))
  623. (setq files
  624. (cl-sort ;Looks funny.
  625. (cl-set-difference
  626. (cl-remove-duplicates
  627. (cl-remove-if-not
  628. (lambda (file) (string-match-p
  629. (car pdf-tools-auto-mode-alist-entry)
  630. file))
  631. files)
  632. :test 'file-equal-p)
  633. searched
  634. :test 'file-equal-p)
  635. 'string-lessp))
  636. (if (null files)
  637. (message "No marked, new PDF files found in windows")
  638. (when (tablist-yes-or-no-p
  639. 'add nil (mapcar (lambda (file)
  640. (cons nil (vector file)))
  641. (cl-sort files 'string-lessp)))
  642. (setq pdf-occur-search-documents
  643. (append pdf-occur-search-documents
  644. (pdf-occur-normalize-documents files)))
  645. (message "Added %d file%s to the list of searched documents%s"
  646. (length files)
  647. (dired-plural-s (length files))
  648. (substitute-command-keys
  649. " - Hit \\[pdf-occur-revert-buffer-with-args]"))))))
  650. ;; * ================================================================== *
  651. ;; * Utilities
  652. ;; * ================================================================== *
  653. (defun pdf-occur-read-string (&optional regexp-p)
  654. (read-string
  655. (concat
  656. (format "List lines %s"
  657. (if regexp-p "matching PCRE" "containing string"))
  658. (if pdf-occur-search-string
  659. (format " (default %s)" pdf-occur-search-string))
  660. ": ")
  661. nil 'pdf-occur-history pdf-occur-search-string))
  662. (defun pdf-occur-assert-occur-buffer-p ()
  663. (unless (derived-mode-p 'pdf-occur-buffer-mode)
  664. (error "Not in PDF occur buffer")))
  665. (defun pdf-occur-want-regexp-search-p ()
  666. (or (and current-prefix-arg
  667. pdf-occur-prefer-string-search)
  668. (and (null current-prefix-arg)
  669. (not pdf-occur-prefer-string-search))))
  670. ;; FIXME: This will be confusing when searching documents with the
  671. ;; same base file-name.
  672. (defun pdf-occur-abbrev-document (file-or-buffer)
  673. (if (bufferp file-or-buffer)
  674. (buffer-name file-or-buffer)
  675. (let ((abbrev (file-name-nondirectory file-or-buffer)))
  676. (if (> (length abbrev) 0)
  677. abbrev
  678. file-or-buffer))))
  679. (defun pdf-occur-create-batches (documents batch-size)
  680. (let (queries)
  681. (dolist (d documents)
  682. (let* ((file-or-buffer (car d))
  683. (pages (pdf-info-normalize-page-range (cdr d)))
  684. (first (car pages))
  685. (last (if (eq (cdr pages) 0)
  686. (pdf-info-number-of-pages file-or-buffer)
  687. (cdr pages)))
  688. (npages (1+ (- last first)))
  689. (nbatches (ceiling
  690. (/ (float npages) batch-size))))
  691. (dotimes (i nbatches)
  692. (push
  693. (list file-or-buffer
  694. (cons (+ first (* i batch-size))
  695. (min last (+ first (1- (* (1+ i) batch-size))))))
  696. queries))))
  697. (nreverse queries)))
  698. (defun pdf-occur-normalize-documents (documents)
  699. "Normalize list of documents.
  700. Replaces buffers with their associated filenames \(if
  701. applicable\) and ensures that every element looks like
  702. \(FILENAME-OR-BUFFER . PAGES\)."
  703. (cl-sort (mapcar (lambda (doc)
  704. (unless (consp doc)
  705. (setq doc (cons doc nil)))
  706. (when (and (bufferp (car doc))
  707. (buffer-file-name (car doc)))
  708. (setq doc (cons (buffer-file-name (car doc))
  709. (cdr doc))))
  710. (if (stringp (car doc))
  711. (cons (expand-file-name (car doc)) (cdr doc))
  712. doc))
  713. documents)
  714. (lambda (a b) (string-lessp
  715. (if (bufferp a) (buffer-name a) a)
  716. (if (bufferp b) (buffer-name b) b)))
  717. :key 'car))
  718. (provide 'pdf-occur)
  719. ;;; pdf-occur.el ends here