Klimi's new dotfiles with stow.
Nevar pievienot vairāk kā 25 tēmas Tēmai ir jāsākas ar burtu vai ciparu, tā var saturēt domu zīmes ('-') un var būt līdz 35 simboliem gara.

1038 rindas
40 KiB

pirms 4 gadiem
  1. ;;; pdf-virtual.el --- Virtual PDF documents -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2015 Andreas Politz
  3. ;; Author: Andreas Politz <politza@hochschule-trier.de>
  4. ;; Keywords: multimedia, files
  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. ;; A virtual PDF is a collection of pages, or parts thereof, of
  17. ;; arbitrary documents in one particular order. This library acts as
  18. ;; an intermediate between pdf-info.el and all other packages, in
  19. ;; order to transparently make this collection appear as one single
  20. ;; document.
  21. ;;
  22. ;; The trickiest part is to make theses intermediate functions behave
  23. ;; like the pdf-info-* equivalents in both the synchronous and
  24. ;; asynchronous case.
  25. ;;; Code:
  26. (eval-when-compile
  27. (unless (or (> emacs-major-version 24)
  28. (and (= emacs-major-version 24)
  29. (>= emacs-minor-version 4)))
  30. (error "pdf-virtual.el only works with Emacs >= 24.4")))
  31. (require 'let-alist)
  32. (require 'pdf-info)
  33. (require 'pdf-util)
  34. ;; * ================================================================== *
  35. ;; * Variables
  36. ;; * ================================================================== *
  37. (defconst pdf-virtual-magic-mode-regexp "^ *;+ *%VPDF\\_>"
  38. "A regexp matching the first line in a vpdf file.")
  39. (defvar-local pdf-virtual-document nil
  40. "A list representing the virtual document.")
  41. (put 'pdf-virtual-document 'permanent-local t)
  42. (defvar pdf-virtual-adapter-alist nil
  43. "Alist of server functions.
  44. Each element looks like \(PDF-VIRTUAL-FN . PDF-INFO-FN\). This
  45. list is filled by the macro `pdf-virtual-define-adapter' and used
  46. to enable/disable the corresponding advices.")
  47. ;; * ================================================================== *
  48. ;; * VPDF datastructure
  49. ;; * ================================================================== *
  50. (defun pdf-virtual-pagespec-normalize (page-spec &optional filename)
  51. "Normalize PAGE-SPEC using FILENAME.
  52. PAGE-SPEC should be as described in
  53. `pdf-virtual-document-create'. FILENAME is used to determine the
  54. last page number, if needed. The `current-buffer', if it is nil.
  55. Returns a list \(\(FIRST . LAST\) . REGION\)\)."
  56. (let ((page-spec (cond
  57. ((natnump page-spec)
  58. (list (cons page-spec page-spec)))
  59. ((null (car page-spec))
  60. (let ((npages (pdf-info-number-of-pages filename)))
  61. (cons (cons 1 npages)
  62. (cdr page-spec))))
  63. ((natnump (car page-spec))
  64. (cond
  65. ((natnump (cdr page-spec))
  66. (list page-spec))
  67. (t
  68. (cons (cons (car page-spec)
  69. (car page-spec))
  70. (cdr page-spec)))))
  71. (t page-spec))))
  72. (when (equal (cdr page-spec)
  73. '(0 0 1 1))
  74. (setq page-spec `((,(caar page-spec) . ,(cdar page-spec)))))
  75. page-spec))
  76. (cl-defstruct pdf-virtual-range
  77. ;; The PDF's filename.
  78. filename
  79. ;; First page in this range.
  80. first
  81. ;; Last page.
  82. last
  83. ;; The edges selected for these pages.
  84. region
  85. ;; The page-index corresponding to the first page in this range.
  86. index-start)
  87. (cl-defstruct pdf-virtual-document
  88. ;; Array of shared pdf-virtual-range structs, one element for each
  89. ;; page.
  90. page-array
  91. ;; An alist mapping filenames to a list of pages.
  92. file-map)
  93. (defun pdf-virtual-range-length (page)
  94. "Return the number of pages in PAGE."
  95. (1+ (- (pdf-virtual-range-last page)
  96. (pdf-virtual-range-first page))))
  97. (defun pdf-virtual-document-create (list &optional directory
  98. file-error-handler)
  99. "Create a virtual PDF from LIST using DIRECTORY.
  100. LIST should be a list of elements \(FILENAME . PAGE-SPECS\),
  101. where FILENAME is a PDF document and PAGE-SPECS is a list of
  102. PAGE-RANGE and/or \(PAGE-RANGE . EDGES\). In the later case,
  103. EDGES should be a list of relative coordinates \(LEFT TOP RIGHT
  104. BOT\) selecting a region of the page(s) in PAGE-RANGE. Giving no
  105. PAGE-SPECs at all is equivalent to all pages of FILENAME.
  106. See `pdf-info-normalize-page-range' for the valid formats of
  107. PAGE-RANGE.
  108. "
  109. (unless (cl-every 'consp list)
  110. (error "Every element should be a cons: %s" list))
  111. (unless (cl-every 'stringp (mapcar 'car list))
  112. (error "The car of every element should be a filename."))
  113. (unless (cl-every (lambda (elt)
  114. (cl-every (lambda (page)
  115. (or (pdf-info-valid-page-spec-p page)
  116. (and (consp page)
  117. (pdf-info-valid-page-spec-p (car page))
  118. (pdf-util-edges-p (cdr page) 'relative))))
  119. elt))
  120. (mapcar 'cdr list))
  121. (error
  122. "The cdr of every element should be a list of page-specs"))
  123. (let* ((doc (pdf-virtual-document--normalize
  124. list (or directory default-directory)
  125. file-error-handler))
  126. (npages 0)
  127. document file-map)
  128. (while doc
  129. (let* ((elt (pop doc))
  130. (filename (car elt))
  131. (mapelt (assoc filename file-map))
  132. (page-specs (cdr elt)))
  133. (if mapelt
  134. (setcdr mapelt (cons (1+ npages) (cdr mapelt)))
  135. (push (list filename (1+ npages)) file-map))
  136. (while page-specs
  137. (let* ((ps (pop page-specs))
  138. (first (caar ps))
  139. (last (cdar ps))
  140. (region (cdr ps))
  141. (clx (make-pdf-virtual-range
  142. :filename filename
  143. :first first
  144. :last last
  145. :region region
  146. :index-start npages)))
  147. (cl-incf npages (1+ (- last first)))
  148. (push (make-vector (1+ (- last first)) clx)
  149. document)))))
  150. (make-pdf-virtual-document
  151. :page-array (apply 'vconcat (nreverse document))
  152. :file-map (nreverse
  153. (mapcar (lambda (f)
  154. (setcdr f (nreverse (cdr f)))
  155. f)
  156. file-map)))))
  157. (defun pdf-virtual-document--normalize (list &optional directory
  158. file-error-handler)
  159. (unless file-error-handler
  160. (setq file-error-handler
  161. (lambda (filename err)
  162. (signal (car err)
  163. (append (cdr err) (list filename))))))
  164. (let ((default-directory
  165. (or directory default-directory)))
  166. (setq list (cl-remove-if-not
  167. (lambda (filename)
  168. (condition-case err
  169. (progn
  170. (unless (file-readable-p filename)
  171. (signal 'file-error
  172. (list "File not readable: " filename)))
  173. (pdf-info-open filename)
  174. t)
  175. (error
  176. (funcall file-error-handler filename err)
  177. nil)))
  178. list
  179. :key 'car))
  180. (let* ((file-attributes (make-hash-table :test 'equal))
  181. (file-equal-p (lambda (f1 f2)
  182. (let ((a1 (gethash f1 file-attributes))
  183. (a2 (gethash f2 file-attributes)))
  184. (if (and a1 a2)
  185. (equal a1 a2)
  186. (file-equal-p f1 f2)))))
  187. files normalized)
  188. ;; Optimize file-equal-p by caching file-attributes, which is slow
  189. ;; and would be called quadratic times otherwise. (We don't want
  190. ;; the same file under different names.)
  191. (dolist (f (mapcar 'car list))
  192. (unless (find-file-name-handler f 'file-equal-p)
  193. (puthash f (file-attributes f) file-attributes)))
  194. (dolist (elt list)
  195. (let ((file (cl-find (car elt) files :test file-equal-p)))
  196. (unless file
  197. (push (car elt) files)
  198. (setq file (car elt)))
  199. (let ((pages (mapcar (lambda (p)
  200. (pdf-virtual-pagespec-normalize p file))
  201. (or (cdr elt) '(nil))))
  202. newpages)
  203. (while pages
  204. (let* ((spec (pop pages))
  205. (first (caar spec))
  206. (last (cdar spec))
  207. (region (cdr spec)))
  208. (while (and pages
  209. (eq (1+ last)
  210. (caar (car pages)))
  211. (equal region (cdr (car pages))))
  212. (setq last (cdar (pop pages))))
  213. (push `((,first . ,last) . ,region) newpages)))
  214. (push (cons file (nreverse newpages))
  215. normalized))))
  216. (nreverse normalized))))
  217. (defmacro pdf-virtual-document-defun (name args &optional documentation &rest body)
  218. "Define a PDF Document function.
  219. Args are just like for `defun'. This macro will ensure, that the
  220. DOCUMENT argument, which should be last, is setup properly in
  221. case it is nil, i.e. check that the buffer passes
  222. `pdf-virtual-buffer-assert-p' and use the variable
  223. `pdf-virtual-document'."
  224. (declare (doc-string 3) (indent defun)
  225. (debug (&define name lambda-list
  226. [&optional stringp]
  227. def-body)))
  228. (unless (stringp documentation)
  229. (push documentation body)
  230. (setq documentation nil))
  231. (unless (memq '&optional args)
  232. (setq args (append (butlast args)
  233. (list '&optional)
  234. (last args))))
  235. (when (memq '&rest args)
  236. (error "&rest argument not supported"))
  237. (let ((doc-arg (car (last args)))
  238. (fn (intern (format "pdf-virtual-document-%s" name))))
  239. `(progn
  240. (put ',fn 'definition-name ',name)
  241. (defun ,fn
  242. ,args ,documentation
  243. (setq ,doc-arg
  244. (or ,doc-arg
  245. (progn (pdf-virtual-buffer-assert-p)
  246. pdf-virtual-document)))
  247. (cl-check-type ,doc-arg pdf-virtual-document)
  248. ,@body))))
  249. (pdf-virtual-document-defun filenames (doc)
  250. "Return the list of filenames in DOC."
  251. (mapcar 'car (pdf-virtual-document-file-map doc)))
  252. (pdf-virtual-document-defun normalize-pages (pages doc)
  253. "Normalize PAGES using DOC.
  254. Like `pdf-info-normalize-page-range', except 0 is replaced by
  255. DOC's last page."
  256. (setq pages (pdf-info-normalize-page-range pages))
  257. (if (eq 0 (cdr pages))
  258. `(,(car pages) . ,(pdf-virtual-document-number-of-pages doc))
  259. pages))
  260. (pdf-virtual-document-defun page (page doc)
  261. "Get PAGE of DOC.
  262. Returns a list \(FILENAME FILE-PAGE REGION\)."
  263. (let ((page (car (pdf-virtual-document-pages (cons page page) doc))))
  264. (when page
  265. (cl-destructuring-bind (filename first-last region)
  266. page
  267. (list filename (car first-last) region)))))
  268. (pdf-virtual-document-defun pages (pages doc)
  269. "Get PAGES of DOC.
  270. PAGES should be a cons \(FIRST . LAST\). Return a list of
  271. ranges corresponding to PAGES. Each element has the form
  272. \(FILENAME \(FILE-FIRT-PAGE . FILE-LAST-PAGE\) REGION\)
  273. .
  274. "
  275. (let ((begin (car pages))
  276. (end (cdr pages)))
  277. (unless (<= begin end)
  278. (error "begin should not exceed end: %s" (cons begin end)))
  279. (let ((arr (pdf-virtual-document-page-array doc))
  280. result)
  281. (when (or (< begin 1)
  282. (> end (length arr)))
  283. (signal 'args-out-of-range (list 'pages pages)))
  284. (while (<= begin end)
  285. (let* ((page (aref arr (1- begin)))
  286. (filename (pdf-virtual-range-filename page))
  287. (offset (- (1- begin)
  288. (pdf-virtual-range-index-start page)))
  289. (first (+ (pdf-virtual-range-first page)
  290. offset))
  291. (last (min (+ first (- end begin))
  292. (pdf-virtual-range-last page)))
  293. (region (pdf-virtual-range-region page)))
  294. (push `(,filename (,first . ,last) ,region) result)
  295. (cl-incf begin (1+ (- last first)))))
  296. (nreverse result))))
  297. (pdf-virtual-document-defun number-of-pages (doc)
  298. "Return the number of pages in DOC."
  299. (length (pdf-virtual-document-page-array doc)))
  300. (pdf-virtual-document-defun page-of (filename &optional file-page limit doc)
  301. "Return a page number displaying FILENAME's page FILE-PAGE in DOC.
  302. If FILE-PAGE is nil, return the first page displaying FILENAME.
  303. If LIMIT is non-nil, it should be a range \(FIRST . LAST\) in
  304. which the returned page should fall. This is useful if there are
  305. more than one page displaying FILE-PAGE. LIMIT is ignored, if
  306. FILE-PAGE is nil.
  307. Return nil if there is no matching page."
  308. (if (null file-page)
  309. (cadr (assoc filename (pdf-virtual-document-file-map doc)))
  310. (let ((pages (pdf-virtual-document-page-array doc)))
  311. (catch 'found
  312. (mapc
  313. (lambda (pn)
  314. (while (and (<= pn (length pages))
  315. (equal (pdf-virtual-range-filename (aref pages (1- pn)))
  316. filename))
  317. (let* ((page (aref pages (1- pn)))
  318. (first (pdf-virtual-range-first page))
  319. (last (pdf-virtual-range-last page)))
  320. (when (and (>= file-page first)
  321. (<= file-page last))
  322. (let ((r (+ (pdf-virtual-range-index-start page)
  323. (- file-page (pdf-virtual-range-first page))
  324. 1)))
  325. (when (or (null limit)
  326. (and (>= r (car limit))
  327. (<= r (cdr limit))))
  328. (throw 'found r))))
  329. (cl-incf pn (1+ (- last first))))))
  330. (cdr (assoc filename (pdf-virtual-document-file-map doc))))
  331. nil))))
  332. (pdf-virtual-document-defun find-matching-page (page predicate
  333. &optional
  334. backward-p doc)
  335. (unless (and (>= page 1)
  336. (<= page (length (pdf-virtual-document-page-array doc))))
  337. (signal 'args-out-of-range (list 'page page)))
  338. (let* ((pages (pdf-virtual-document-page-array doc))
  339. (i (1- page))
  340. (this (aref pages i))
  341. other)
  342. (while (and (< i (length pages))
  343. (>= i 0)
  344. (null other))
  345. (setq i
  346. (if backward-p
  347. (1- (pdf-virtual-range-index-start this))
  348. (+ (pdf-virtual-range-length this)
  349. (pdf-virtual-range-index-start this))))
  350. (when (and (< i (length pages))
  351. (>= i 0))
  352. (setq other (aref pages i))
  353. (unless (funcall predicate this other)
  354. (setq other nil))))
  355. other))
  356. (pdf-virtual-document-defun next-matching-page (page predicate doc)
  357. (pdf-virtual-document-find-matching-page page predicate nil doc))
  358. (pdf-virtual-document-defun previous-matching-page (page predicate doc)
  359. (declare (indent 1))
  360. (pdf-virtual-document-find-matching-page page predicate t doc))
  361. (pdf-virtual-document-defun next-file (page doc)
  362. "Return the next page displaying a different file than PAGE.
  363. PAGE should be a page-number."
  364. (let ((page (pdf-virtual-document-next-matching-page
  365. page
  366. (lambda (this other)
  367. (not (equal (pdf-virtual-range-filename this)
  368. (pdf-virtual-range-filename other)))))))
  369. (when page
  370. (1+ (pdf-virtual-range-index-start page)))))
  371. (pdf-virtual-document-defun previous-file (page doc)
  372. "Return the previous page displaying a different file than PAGE.
  373. PAGE should be a page-number."
  374. (let ((page (pdf-virtual-document-previous-matching-page
  375. page
  376. (lambda (this other)
  377. (not (equal (pdf-virtual-range-filename this)
  378. (pdf-virtual-range-filename other)))))))
  379. (when page
  380. (1+ (pdf-virtual-range-index-start page)))))
  381. ;; * ================================================================== *
  382. ;; * Modes
  383. ;; * ================================================================== *
  384. (defvar pdf-virtual-edit-mode-map
  385. (let ((map (make-sparse-keymap)))
  386. (set-keymap-parent map emacs-lisp-mode-map)
  387. (define-key map (kbd "C-c C-c") 'pdf-virtual-view-mode)
  388. map))
  389. ;;;###autoload
  390. (define-derived-mode pdf-virtual-edit-mode emacs-lisp-mode "VPDF-Edit"
  391. "Major mode when editing a virtual PDF buffer."
  392. (buffer-enable-undo)
  393. (setq-local buffer-read-only nil)
  394. (unless noninteractive
  395. (message (substitute-command-keys "Press \\[pdf-virtual-view-mode] to view."))))
  396. ;; FIXME: Provide filename/region from-windows-gathering functions.
  397. (defvar pdf-virtual-view-mode-map
  398. (let ((map (make-sparse-keymap)))
  399. (set-keymap-parent map pdf-view-mode-map)
  400. (define-key map (kbd "C-c C-c") 'pdf-virtual-edit-mode)
  401. (define-key map [remap backward-paragraph] 'pdf-virtual-buffer-backward-file)
  402. (define-key map [remap forward-paragraph] 'pdf-virtual-buffer-forward-file)
  403. (define-key map (kbd "C-c C-c") 'pdf-virtual-edit-mode)
  404. map))
  405. ;;;###autoload
  406. (define-derived-mode pdf-virtual-view-mode pdf-view-mode "VPDF-View"
  407. "Major mode in virtual PDF buffers."
  408. (setq-local write-contents-functions nil)
  409. (remove-hook 'kill-buffer-hook 'pdf-view-close-document t)
  410. (setq-local header-line-format
  411. `(:eval (pdf-virtual-buffer-current-file)))
  412. (unless noninteractive
  413. (message (substitute-command-keys "Press \\[pdf-virtual-edit-mode] to edit."))))
  414. ;;;###autoload
  415. (define-minor-mode pdf-virtual-global-minor-mode
  416. "Enable recognition and handling of VPDF files."
  417. nil nil nil
  418. :global t
  419. (let ((elt `(,pdf-virtual-magic-mode-regexp . pdf-virtual-view-mode)))
  420. (cond
  421. (pdf-virtual-global-minor-mode
  422. (add-to-list 'magic-mode-alist elt))
  423. (t
  424. (setq magic-mode-alist
  425. (remove elt magic-mode-alist))))
  426. (dolist (elt pdf-virtual-adapter-alist)
  427. (let ((fn (car elt))
  428. (orig (cdr elt)))
  429. (advice-remove orig fn)
  430. (when pdf-virtual-global-minor-mode
  431. (advice-add orig :around fn))))))
  432. (advice-add 'pdf-virtual-view-mode
  433. :around 'pdf-virtual-view-mode-prepare)
  434. ;; This needs to run before pdf-view-mode does its thing.
  435. (defun pdf-virtual-view-mode-prepare (fn)
  436. (let (list unreadable)
  437. (save-excursion
  438. (goto-char 1)
  439. (unless (looking-at pdf-virtual-magic-mode-regexp)
  440. (pdf-virtual-buffer-assert-p))
  441. (setq list (read (current-buffer))))
  442. (setq pdf-virtual-document
  443. (pdf-virtual-document-create
  444. list
  445. nil
  446. (lambda (filename _error)
  447. (push filename unreadable))))
  448. (when unreadable
  449. (display-warning
  450. 'pdf-virtual
  451. (format "Some documents could not be opened:\n%s"
  452. (mapconcat (lambda (f)
  453. (concat " " f))
  454. unreadable "\n"))))
  455. (if (= (pdf-virtual-document-number-of-pages) 0)
  456. (error "Docüment is empty.")
  457. (unless pdf-virtual-global-minor-mode
  458. (pdf-virtual-global-minor-mode 1))
  459. (funcall fn))))
  460. ;; * ================================================================== *
  461. ;; * Buffer handling
  462. ;; * ================================================================== *
  463. ;;;###autoload
  464. (defun pdf-virtual-buffer-create (&optional filenames buffer-name display-p)
  465. (interactive
  466. (list (directory-files default-directory nil "\\.pdf\\'")
  467. (read-string
  468. "Buffer name (default: all.vpdf): " nil nil "all.vpdf") t))
  469. (with-current-buffer (generate-new-buffer buffer-name)
  470. (insert ";; %VPDF 1.0\n\n")
  471. (insert ";; File Format
  472. ;;
  473. ;; FORMAT ::= ( FILES* )
  474. ;; FILES ::= ( FILE . PAGE-SPEC* )
  475. ;; PAGE-SPEC ::= PAGE | ( PAGE . REGION )
  476. ;; PAGE ::= NUMBER | ( FIRST . LAST )
  477. ;; REGION ::= ( LEFT TOP RIGHT BOT )
  478. ;;
  479. ;; 0 <= X <= 1, forall X in REGION .
  480. ")
  481. (if (null filenames)
  482. (insert "nil\n")
  483. (insert "(")
  484. (dolist (f filenames)
  485. (insert (format "(%S)\n " f)))
  486. (delete-char -2)
  487. (insert ")\n"))
  488. (pdf-virtual-edit-mode)
  489. (when display-p
  490. (pop-to-buffer (current-buffer)))
  491. (current-buffer)))
  492. (defun pdf-virtual-buffer-p (&optional buffer)
  493. (save-current-buffer
  494. (when buffer (set-buffer buffer))
  495. (or (derived-mode-p 'pdf-virtual-view-mode 'pdf-virtual-edit-mode)
  496. pdf-virtual-document)))
  497. (defun pdf-virtual-view-window-p (&optional window)
  498. (save-selected-window
  499. (when window (select-window window))
  500. (derived-mode-p 'pdf-virtual-view-mode)))
  501. (defun pdf-virtual-filename-p (filename)
  502. (and (stringp filename)
  503. (file-exists-p filename)
  504. (with-temp-buffer
  505. (save-excursion (insert-file-contents filename nil 0 128))
  506. (looking-at pdf-virtual-magic-mode-regexp))))
  507. (defun pdf-virtual-buffer-assert-p (&optional buffer)
  508. (unless (pdf-virtual-buffer-p buffer)
  509. (error "Buffer is not a virtual PDF buffer")))
  510. (defun pdf-virtual-view-window-assert-p (&optional window)
  511. (unless (pdf-virtual-view-window-p window)
  512. (error "Window's buffer is not in `pdf-virtual-view-mode'.")))
  513. (defun pdf-virtual-buffer-current-file (&optional window)
  514. (pdf-virtual-view-window-assert-p window)
  515. (pdf-virtual-range-filename
  516. (aref (pdf-virtual-document-page-array
  517. pdf-virtual-document)
  518. (1- (pdf-view-current-page window)))))
  519. (defun pdf-virtual-buffer-forward-file (&optional n interactive-p)
  520. (interactive "p\np")
  521. (pdf-virtual-view-window-assert-p)
  522. (let* ((pn (pdf-view-current-page))
  523. (pages (pdf-virtual-document-page-array
  524. pdf-virtual-document))
  525. (page (aref pages (1- pn)))
  526. (first-filepage (1+ (pdf-virtual-range-index-start page))))
  527. (when (and (< n 0)
  528. (not (= first-filepage pn)))
  529. (cl-incf n))
  530. (setq pn first-filepage)
  531. (let (next)
  532. (while (and (> n 0)
  533. (setq next (pdf-virtual-document-next-file pn)))
  534. (setq pn next)
  535. (cl-decf n)))
  536. (let (previous)
  537. (while (and (< n 0)
  538. (setq previous (pdf-virtual-document-previous-file pn)))
  539. (setq pn previous)
  540. (cl-incf n)))
  541. (when interactive-p
  542. (when (< n 0)
  543. (message "First file."))
  544. (when (> n 0)
  545. (message "Last file.")))
  546. (pdf-view-goto-page pn)
  547. n))
  548. (defun pdf-virtual-buffer-backward-file (&optional n interactive-p)
  549. (interactive "p\np")
  550. (pdf-virtual-buffer-forward-file (- (or n 1)) interactive-p))
  551. ;; * ================================================================== *
  552. ;; * Helper functions
  553. ;; * ================================================================== *
  554. (defmacro pdf-virtual-dopages (bindings pages &rest body)
  555. (declare (indent 2) (debug (sexp form &rest form)))
  556. (let ((page (make-symbol "page")))
  557. `(dolist (,page ,pages)
  558. (cl-destructuring-bind ,bindings
  559. ,page
  560. ,@body))))
  561. (defun pdf-virtual--perform-search (string pages &optional regexp-p no-error)
  562. (let* ((pages (pdf-virtual-document-normalize-pages pages))
  563. (file-pages (pdf-virtual-document-pages pages)))
  564. (pdf-info-compose-queries
  565. ((responses
  566. (pdf-virtual-dopages (filename pages _region)
  567. file-pages
  568. (if regexp-p
  569. (pdf-info-search-string string pages filename)
  570. ;; FIXME: no-error won't work with synchronous calls.
  571. (pdf-info-search-regexp string pages no-error filename)))))
  572. (let (result)
  573. (pdf-virtual-dopages (filename _ region)
  574. file-pages
  575. (let ((matches (pop responses)))
  576. (when region
  577. (setq matches
  578. (mapcar
  579. (lambda (m)
  580. (let-alist m
  581. `((edges . ,(pdf-util-edges-transform region .edges t))
  582. ,@m)))
  583. (pdf-virtual--filter-edges
  584. region matches
  585. (apply-partially 'alist-get 'edges)))))
  586. (dolist (m matches)
  587. (push `((page . ,(pdf-virtual-document-page-of
  588. filename (alist-get 'page m)
  589. pages))
  590. ,@m)
  591. result))))
  592. (nreverse result)))))
  593. (defun pdf-virtual--filter-edges (region elts &optional edges-key-fn)
  594. (if (null region)
  595. elts
  596. (cl-remove-if-not
  597. (lambda (edges)
  598. (or (null edges)
  599. (if (consp (car edges))
  600. (cl-some (apply-partially 'pdf-util-edges-intersection region) edges)
  601. (pdf-util-edges-intersection region edges))))
  602. elts
  603. :key edges-key-fn)))
  604. (defun pdf-virtual--transform-goto-dest (link filename region)
  605. (let-alist link
  606. (let ((local-page (pdf-virtual-document-page-of
  607. filename .page)))
  608. (if local-page
  609. `((type . ,'goto-dest)
  610. (title . , .title)
  611. (page . ,local-page)
  612. (top . ,(car (pdf-util-edges-transform
  613. region (cons .top .top) t))))
  614. `((type . ,'goto-remote)
  615. (title . , .title)
  616. (filename . ,filename)
  617. (page . , .page)
  618. (top . , .top))))))
  619. ;; * ================================================================== *
  620. ;; * Server adapter
  621. ;; * ================================================================== *
  622. (defmacro pdf-virtual-define-adapter (name arglist &optional doc &rest body)
  623. ;; FIXME: Handle &optional + &rest argument.
  624. (declare (doc-string 3) (indent 2)
  625. (debug (&define name lambda-list
  626. [&optional stringp]
  627. def-body)))
  628. (unless (stringp doc)
  629. (push doc body)
  630. (setq doc nil))
  631. (let ((fn (intern (format "pdf-virtual-%s" name)))
  632. (base-fn (intern (format "pdf-info-%s" name)))
  633. (base-fn-arg (make-symbol "fn"))
  634. (true-file-or-buffer (make-symbol "true-file-or-buffer"))
  635. (args (cl-remove-if (lambda (elt)
  636. (memq elt '(&optional &rest)))
  637. arglist)))
  638. (unless (fboundp base-fn)
  639. (error "Base function is undefined: %s" base-fn))
  640. (unless (memq 'file-or-buffer arglist)
  641. (error "Argument list is missing a `file-or-buffer' argument: %s" arglist))
  642. `(progn
  643. (put ',fn 'definition-name ',name)
  644. (add-to-list 'pdf-virtual-adapter-alist ',(cons fn base-fn))
  645. (defun ,fn ,(cons base-fn-arg arglist)
  646. ,(format "%sPDF virtual adapter to `%s'.
  647. This function delegates to `%s', unless the FILE-OR-BUFFER
  648. argument denotes a VPDF document."
  649. (if doc (concat doc "\n\n") "")
  650. base-fn
  651. base-fn)
  652. (let ((,true-file-or-buffer
  653. (cond
  654. ((or (bufferp file-or-buffer)
  655. (stringp file-or-buffer)) file-or-buffer)
  656. ((or (null file-or-buffer)
  657. ,(not (null (memq '&rest arglist))))
  658. (current-buffer)))))
  659. (if (cond
  660. ((null ,true-file-or-buffer) t)
  661. ((bufferp ,true-file-or-buffer)
  662. (not (pdf-virtual-buffer-p ,true-file-or-buffer)))
  663. ((stringp ,true-file-or-buffer)
  664. (not (pdf-virtual-filename-p ,true-file-or-buffer))))
  665. (,(if (memq '&rest arglist) 'apply 'funcall) ,base-fn-arg ,@args)
  666. (when (stringp ,true-file-or-buffer)
  667. (setq ,true-file-or-buffer
  668. (find-file-noselect ,true-file-or-buffer)))
  669. (save-current-buffer
  670. (when (bufferp ,true-file-or-buffer)
  671. (set-buffer ,true-file-or-buffer))
  672. ,@body)))))))
  673. (define-error 'pdf-virtual-unsupported-operation
  674. "Operation not supported in VPDF buffer")
  675. (pdf-virtual-define-adapter open (&optional file-or-buffer password)
  676. (mapc (lambda (file)
  677. (pdf-info-open file password))
  678. (pdf-virtual-document-filenames)))
  679. (pdf-virtual-define-adapter close (&optional file-or-buffer)
  680. (let ((files (cl-remove-if 'find-buffer-visiting
  681. (pdf-virtual-document-filenames))))
  682. (pdf-info-compose-queries
  683. ((results (mapc 'pdf-info-close files)))
  684. (cl-some 'identity results))))
  685. (pdf-virtual-define-adapter metadata (&optional file-or-buffer)
  686. (pdf-info-compose-queries
  687. ((md (mapc 'pdf-info-metadata (pdf-virtual-document-filenames))))
  688. (apply 'cl-mapcar (lambda (&rest elts)
  689. (cons (caar elts)
  690. (cl-mapcar 'cdr elts)))
  691. md)))
  692. (pdf-virtual-define-adapter search-string (string &optional pages file-or-buffer)
  693. (pdf-virtual--perform-search
  694. string (pdf-virtual-document-normalize-pages pages)))
  695. (pdf-virtual-define-adapter search-regexp (pcre &optional
  696. pages no-error file-or-buffer)
  697. (pdf-virtual--perform-search
  698. pcre (pdf-virtual-document-normalize-pages pages) 'regexp no-error))
  699. (pdf-virtual-define-adapter pagelinks (page &optional file-or-buffer)
  700. (cl-destructuring-bind (filename ext-page region)
  701. (pdf-virtual-document-page page)
  702. (pdf-info-compose-queries
  703. ((links (pdf-info-pagelinks ext-page filename)))
  704. (mapcar
  705. (lambda (link)
  706. (let-alist link
  707. (if (not (eq .type 'goto-dest))
  708. link
  709. `((edges . ,(pdf-util-edges-transform region .edges t))
  710. ,@(pdf-virtual--transform-goto-dest link filename region)))))
  711. (pdf-virtual--filter-edges region (car links) 'car)))))
  712. (pdf-virtual-define-adapter number-of-pages (&optional file-or-buffer)
  713. (pdf-info-compose-queries nil (pdf-virtual-document-number-of-pages)))
  714. (pdf-virtual-define-adapter outline (&optional file-or-buffer)
  715. (let ((files (pdf-virtual-document-filenames)))
  716. (pdf-info-compose-queries
  717. ((outlines (mapc 'pdf-info-outline files)))
  718. (cl-mapcan
  719. (lambda (outline filename)
  720. `(((depth . 1)
  721. (type . goto-dest)
  722. (title . ,filename)
  723. (page . ,(pdf-virtual-document-page-of filename))
  724. (top . 0))
  725. ,@(delq
  726. nil
  727. (mapcar
  728. (lambda (item)
  729. (let-alist item
  730. (if (not (eq .type 'goto-dest))
  731. `((depth . ,(1+ .depth))
  732. ,@item)
  733. (cl-check-type filename string)
  734. (let ((page (pdf-virtual-document-page-of
  735. filename .page)))
  736. (when page
  737. `((depth . ,(1+ .depth))
  738. ,@(pdf-virtual--transform-goto-dest
  739. item filename
  740. (nth 2 (pdf-virtual-document-page page)))))))))
  741. outline))))
  742. outlines files))))
  743. (pdf-virtual-define-adapter gettext (page edges &optional
  744. selection-style file-or-buffer)
  745. (cl-destructuring-bind (filename file-page region)
  746. (pdf-virtual-document-page page)
  747. (let ((edges (pdf-util-edges-transform region edges)))
  748. (pdf-info-gettext file-page edges selection-style filename))))
  749. (pdf-virtual-define-adapter getselection (page edges &optional
  750. selection-style file-or-buffer)
  751. (cl-destructuring-bind (filename file-page region)
  752. (pdf-virtual-document-page page)
  753. (let ((edges (pdf-util-edges-transform region edges)))
  754. (pdf-info-compose-queries
  755. ((results (pdf-info-getselection file-page edges selection-style filename)))
  756. (pdf-util-edges-transform
  757. region
  758. (pdf-virtual--filter-edges region (car results)) t)))))
  759. (pdf-virtual-define-adapter charlayout (page &optional edges-or-pos file-or-buffer)
  760. (cl-destructuring-bind (filename file-page region)
  761. (pdf-virtual-document-page page)
  762. (let ((edges-or-pos (pdf-util-edges-transform region edges-or-pos)))
  763. (pdf-info-compose-queries
  764. ((results (pdf-info-charlayout file-page edges-or-pos filename)))
  765. (mapcar (lambda (elt)
  766. `(,(car elt)
  767. . ,(pdf-util-edges-transform region (cdr elt) t)))
  768. (pdf-virtual--filter-edges region (car results) 'cadr))))))
  769. (pdf-virtual-define-adapter pagesize (page &optional file-or-buffer)
  770. (cl-destructuring-bind (filename file-page region)
  771. (pdf-virtual-document-page page)
  772. (pdf-info-compose-queries
  773. ((result (pdf-info-pagesize file-page filename)))
  774. (if (null region)
  775. (car result)
  776. (pdf-util-with-edges (region)
  777. (pdf-util-scale
  778. (car result) (cons region-width region-height)))))))
  779. (pdf-virtual-define-adapter getannots (&optional pages file-or-buffer)
  780. (let* ((pages (pdf-virtual-document-normalize-pages pages))
  781. (file-pages (pdf-virtual-document-pages pages)))
  782. (pdf-info-compose-queries
  783. ((annotations
  784. (pdf-virtual-dopages (filename file-pages _region)
  785. file-pages
  786. (pdf-info-getannots file-pages filename))))
  787. (let ((page (car pages))
  788. result)
  789. (pdf-virtual-dopages (_filename file-pages region)
  790. file-pages
  791. (dolist (a (pop annotations))
  792. (let ((edges (delq nil `(,(cdr (assq 'edges a))
  793. ,@(cdr (assq 'markup-edges a))))))
  794. (when (pdf-virtual--filter-edges region edges)
  795. (let-alist a
  796. (setcdr (assq 'page a)
  797. (+ page (- .page (car file-pages))))
  798. (setcdr (assq 'id a)
  799. (intern (format "%s/%d" .id (cdr (assq 'page a)))))
  800. (when region
  801. (when .edges
  802. (setcdr (assq 'edges a)
  803. (pdf-util-edges-transform region .edges t)))
  804. (when .markup-edges
  805. (setcdr (assq 'markup-edges a)
  806. (pdf-util-edges-transform region .markup-edges t))))
  807. (push a result)))))
  808. (cl-incf page (1+ (- (cdr file-pages) (car file-pages)))))
  809. (nreverse result)))))
  810. (pdf-virtual-define-adapter getannot (id &optional file-or-buffer)
  811. (let ((name (symbol-name id))
  812. page)
  813. (save-match-data
  814. (when (string-match "\\(.*\\)/\\([0-9]+\\)\\'" name)
  815. (setq id (intern (match-string 1 name))
  816. page (string-to-number (match-string 2 name)))))
  817. (if page
  818. (cl-destructuring-bind (filename _ _)
  819. (pdf-virtual-document-page page)
  820. (pdf-info-compose-queries
  821. ((result (pdf-info-getannot id filename)))
  822. (let ((a (car result)))
  823. (cl-destructuring-bind (_ _ region)
  824. (pdf-virtual-document-page page)
  825. (setcdr (assq 'page a) page)
  826. (let-alist a
  827. (setcdr (assq 'id a)
  828. (intern (format "%s/%d" .id (cdr (assq 'page a)))))
  829. (when region
  830. (when .edges
  831. (setcdr (assq 'edges a)
  832. (pdf-util-edges-transform region .edges t)))
  833. (when .markup-edges
  834. (setcdr (assq 'markup-edges a)
  835. (pdf-util-edges-transform region .markup-edges t))))))
  836. a)))
  837. (pdf-info-compose-queries nil
  838. (error "No such annotation: %s" id)))))
  839. (pdf-virtual-define-adapter addannot (page edges type &optional
  840. file-or-buffer &rest markup-edges)
  841. (signal 'pdf-virtual-unsupported-operation (list 'addannot)))
  842. (pdf-virtual-define-adapter delannot (id &optional file-or-buffer)
  843. (signal 'pdf-virtual-unsupported-operation (list 'delannot)))
  844. (pdf-virtual-define-adapter mvannot (id edges &optional file-or-buffer)
  845. (signal 'pdf-virtual-unsupported-operation (list 'mvannot)))
  846. (pdf-virtual-define-adapter editannot (id modifications &optional file-or-buffer)
  847. (signal 'pdf-virtual-unsupported-operation (list 'editannot)))
  848. (pdf-virtual-define-adapter save (&optional file-or-buffer)
  849. (signal 'pdf-virtual-unsupported-operation (list 'save)))
  850. ;;(defvar-local pdf-virtual-annotation-mapping nil)
  851. (pdf-virtual-define-adapter getattachment-from-annot
  852. (id &optional do-save file-or-buffer)
  853. (let ((name (symbol-name id))
  854. page)
  855. (save-match-data
  856. (when (string-match "\\(.*\\)/\\([0-9]+\\)\\'" name)
  857. (setq id (intern (match-string 1 name))
  858. page (string-to-number (match-string 2 name)))))
  859. (if page
  860. (cl-destructuring-bind (filename _ _)
  861. (pdf-virtual-document-page page)
  862. (pdf-info-getattachment-from-annot id do-save filename))
  863. (pdf-info-compose-queries nil
  864. (error "No such annotation: %s" id)))))
  865. (pdf-virtual-define-adapter getattachments (&optional do-save file-or-buffer)
  866. (pdf-info-compose-queries
  867. ((results (mapc
  868. (lambda (f)
  869. (pdf-info-getattachments do-save f))
  870. (pdf-virtual-document-filenames))))
  871. (apply 'append results)))
  872. (pdf-virtual-define-adapter synctex-forward-search
  873. (source &optional line column file-or-buffer)
  874. (signal 'pdf-virtual-unsupported-operation (list 'synctex-forward-search)))
  875. (pdf-virtual-define-adapter synctex-backward-search (page &optional x y file-or-buffer)
  876. (cl-destructuring-bind (filename file-page region)
  877. (pdf-virtual-document-page page)
  878. (cl-destructuring-bind (x &rest y)
  879. (pdf-util-edges-transform region (cons x y))
  880. (pdf-info-synctex-backward-search file-page x y filename))))
  881. (pdf-virtual-define-adapter renderpage (page width &optional file-or-buffer
  882. &rest commands)
  883. (when (keywordp file-or-buffer)
  884. (push file-or-buffer commands)
  885. (setq file-or-buffer nil))
  886. (cl-destructuring-bind (filename file-page region)
  887. (pdf-virtual-document-page page)
  888. (when region
  889. (setq commands (append (list :crop-to region) commands)
  890. width (pdf-util-with-edges (region)
  891. (round (* width (max 1 (/ 1.0 (max 1e-6 region-width))))))))
  892. (apply 'pdf-info-renderpage file-page width filename commands)))
  893. (pdf-virtual-define-adapter boundingbox (page &optional file-or-buffer)
  894. (cl-destructuring-bind (filename file-page region)
  895. (pdf-virtual-document-page page)
  896. (pdf-info-compose-queries
  897. ((results (unless region (pdf-info-boundingbox file-page filename))))
  898. (if region
  899. (list 0 0 1 1)
  900. (car results)))))
  901. (pdf-virtual-define-adapter pagelabels (&optional file-or-buffer)
  902. (signal 'pdf-virtual-unsupported-operation (list 'pagelabels)))
  903. (pdf-virtual-define-adapter setoptions (&optional file-or-buffer &rest options)
  904. (when (keywordp file-or-buffer)
  905. (push file-or-buffer options)
  906. (setq file-or-buffer nil))
  907. (pdf-info-compose-queries
  908. ((_ (dolist (f (pdf-virtual-document-filenames))
  909. (apply 'pdf-info-setoptions f options))))
  910. nil))
  911. (pdf-virtual-define-adapter getoptions (&optional file-or-buffer)
  912. (signal 'pdf-virtual-unsupported-operation (list 'getoptions)))
  913. (pdf-virtual-define-adapter encrypted-p (&optional file-or-buffer)
  914. nil)
  915. (provide 'pdf-virtual)
  916. ;;; pdf-virtual.el ends here