Klimi's new dotfiles with stow.
Vous ne pouvez pas sélectionner plus de 25 sujets Les noms de sujets doivent commencer par une lettre ou un nombre, peuvent contenir des tirets ('-') et peuvent comporter jusqu'à 35 caractères.

1744 lignes
62 KiB

il y a 4 ans
  1. ;;; pdf-info.el --- Extract info from pdf-files via a helper process. -*- 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. ;; This library represents the Lisp side of the epdfinfo server. This
  18. ;; program works on a command/response basis, but there should be no
  19. ;; need to understand the protocol, since every command has a
  20. ;; corresponding Lisp-function (see below under `High level
  21. ;; interface').
  22. ;;
  23. ;; Most of these functions receive a file-or-buffer argument, which
  24. ;; may be what it says and defaults to the current buffer. Also, most
  25. ;; functions return some sort of alist, with, in most cases,
  26. ;; straight-forward key-value-pairs. Though some may be only
  27. ;; understandable in the context of Adobe's PDF spec \(Adobe
  28. ;; PDF32000\) or the poppler documentation (e.g. annotation flags).
  29. ;;
  30. ;; If the poppler library is fairly recent (>= 0.19.4, older versions
  31. ;; have a bug, which may corrupt the document), annotations maybe
  32. ;; modified to a certain degree, deleted and text-annotations created.
  33. ;; The state of these modifications is held in the server. In order
  34. ;; to realize, annotations retrieved or created are referenced by a
  35. ;; unique symbol. Saving these changes creates a new file, the
  36. ;; original document is never touched.
  37. ;;; Todo:
  38. ;;
  39. ;; + Close documents at some time (e.g. when the buffer is killed)
  40. ;;
  41. ;;; Code:
  42. (require 'tq)
  43. (require 'cl-lib)
  44. ;; * ================================================================== *
  45. ;; * Customizations
  46. ;; * ================================================================== *
  47. (defgroup pdf-info nil
  48. "Extract infos from pdf-files via a helper process."
  49. :group 'pdf-tools)
  50. (defcustom pdf-info-epdfinfo-program
  51. (let ((executable (if (eq system-type 'windows-nt)
  52. "epdfinfo.exe" "epdfinfo"))
  53. (default-directory
  54. (or (and load-file-name
  55. (file-name-directory load-file-name))
  56. default-directory)))
  57. (cl-labels ((try-directory (directory)
  58. (and (file-directory-p directory)
  59. (file-executable-p (expand-file-name executable directory))
  60. (expand-file-name executable directory))))
  61. (or (executable-find executable)
  62. ;; This works if epdfinfo is in the same place as emacs and
  63. ;; the editor was started with an absolute path, i.e. it is
  64. ;; meant for Windows/Msys2.
  65. (and (stringp (car-safe command-line-args))
  66. (file-name-directory (car command-line-args))
  67. (try-directory
  68. (file-name-directory (car command-line-args))))
  69. ;; If we are running directly from the git repo.
  70. (try-directory (expand-file-name "../server"))
  71. ;; Fall back to epdfinfo in the directory of this file.
  72. (expand-file-name executable))))
  73. "Filename of the epdfinfo executable."
  74. :group 'pdf-info
  75. :type 'file)
  76. (defcustom pdf-info-epdfinfo-error-filename nil
  77. "Filename for error output of the epdfinfo executable.
  78. If nil, discard any error messages. Useful for debugging."
  79. :group 'pdf-info
  80. :type `(choice (const :tag "None" nil)
  81. ,@(when (file-directory-p "/tmp/")
  82. '((const "/tmp/epdfinfo.log")))
  83. (file)))
  84. (defcustom pdf-info-log nil
  85. "Whether to log the communication with the server.
  86. If this is non-nil, all communication with the epdfinfo program
  87. will be logged to the buffer \"*pdf-info-log*\"."
  88. :group 'pdf-info
  89. :type 'boolean)
  90. (defcustom pdf-info-log-entry-max 512
  91. "Maximum number of characters in a single log entry.
  92. This variable has no effect if `pdf-info-log' is nil."
  93. :group 'pdf-info
  94. :type 'integer)
  95. (defcustom pdf-info-restart-process-p 'ask
  96. "What to do when the epdfinfo server died.
  97. This should be one of
  98. nil -- do nothing,
  99. t -- automatically restart it or
  100. ask -- ask whether to restart or not.
  101. If it is `ask', the server quits and you answer no, this variable
  102. is set to nil."
  103. :group 'pdf-info
  104. :type '(choice (const :tag "Do nothing" nil)
  105. (const :tag "Restart silently" t)
  106. (const :tag "Always ask" ask)))
  107. (defcustom pdf-info-close-document-hook nil
  108. "A hook ran after a document was closed in the server.
  109. The hook is run in the documents buffer, if it exists. Otherwise
  110. in a `with-temp-buffer' form."
  111. :group 'pdf-info
  112. :type 'hook)
  113. ;; * ================================================================== *
  114. ;; * Variables
  115. ;; * ================================================================== *
  116. (defvar pdf-info-asynchronous nil
  117. "If non-nil process queries asynchronously.
  118. More specifically the value should be a function of at 2
  119. arguments \(fn STATUS RESPONSE\), where STATUS is either nil, for
  120. a successful query, or the symbol error. RESPONSE is either the
  121. command's response or the error message. This does not work
  122. recursive, i.e. if function wants to make another asynchronous
  123. query it has to rebind this variable.
  124. Alternatively it may be a list \(FN . ARGS\), in which case FN
  125. will be invoked like \(apply FN STATUS RESPONSE ARGS\).
  126. Also, all pdf-info functions normally returning a response return
  127. nil.
  128. This variable should only be let-bound.")
  129. (defconst pdf-info-pdf-date-regexp
  130. ;; Adobe PDF32000.book, 7.9.4 Dates
  131. (eval-when-compile
  132. (concat
  133. ;; allow for preceding garbage
  134. ;;"\\`"
  135. "[dD]:"
  136. "\\([0-9]\\{4\\}\\)" ;year
  137. "\\(?:"
  138. "\\([0-9]\\{2\\}\\)" ;month
  139. "\\(?:"
  140. "\\([0-9]\\{2\\}\\)" ;day
  141. "\\(?:"
  142. "\\([0-9]\\{2\\}\\)" ;hour
  143. "\\(?:"
  144. "\\([0-9]\\{2\\}\\)" ;minutes
  145. "\\(?:"
  146. "\\([0-9]\\{2\\}\\)" ;seconds
  147. "\\)?\\)?\\)?\\)?\\)?"
  148. "\\(?:"
  149. "\\([+-Zz]\\)" ;UT delta char
  150. "\\(?:"
  151. "\\([0-9]\\{2\\}\\)" ;UT delta hours
  152. "\\(?:"
  153. "'"
  154. "\\([0-9]\\{2\\}\\)" ;UT delta minutes
  155. "\\)?\\)?\\)?"
  156. ;; "\\'"
  157. ;; allow for trailing garbage
  158. )))
  159. (defvar pdf-info--queue t
  160. "Internally used transmission-queue for the server.
  161. This variable is initially `t', telling the code starting the
  162. server, that it never ran.")
  163. ;; * ================================================================== *
  164. ;; * Process handling
  165. ;; * ================================================================== *
  166. (defconst pdf-info-empty-page-data
  167. (eval-when-compile
  168. (concat
  169. "%PDF-1.0\n1 0 obj<</Type/Catalog/Pages 2 0 R>>endobj 2 0"
  170. " obj<</Type/Pages/Kids[3 0 R]/Count 1>>endobj 3 0 obj<</"
  171. "Type/Page/MediaBox[0 0 3 3]>>endobj\nxref\n0 4\n00000000"
  172. "0065535 f\n0000000010 00000 n\n0000000053 00000 n\n00000"
  173. "00102 00000 n\ntrailer<</Size 4/Root 1 0 R>>\nstartxref\n149\n%EOF"))
  174. "PDF data of an empty page.")
  175. (defun pdf-info-process ()
  176. "Return the process object or nil."
  177. (and pdf-info--queue
  178. (not (eq t pdf-info--queue))
  179. (tq-process pdf-info--queue)))
  180. (defun pdf-info-check-epdfinfo (&optional interactive-p)
  181. "Check if the server should be working properly.
  182. Signal an error if some problem was found. Message a
  183. confirmation, if INTERACTIVE-P is non-nil and no problems were
  184. found.
  185. Returns nil."
  186. (interactive "p")
  187. (let ((executable pdf-info-epdfinfo-program))
  188. (unless (stringp executable)
  189. (error "pdf-info-epdfinfo-program is unset or not a string"))
  190. (unless (file-executable-p executable)
  191. (error "pdf-info-epdfinfo-program is not executable"))
  192. (when pdf-info-epdfinfo-error-filename
  193. (unless (and (stringp pdf-info-epdfinfo-error-filename)
  194. (file-writable-p pdf-info-epdfinfo-error-filename))
  195. (error "pdf-info-epdfinfo-error-filename should contain writable filename")))
  196. (let* ((default-directory (expand-file-name "~/"))
  197. (cmdfile (make-temp-file "commands"))
  198. (pdffile (make-temp-file "empty.pdf"))
  199. (tempdir (make-temp-file "tmpdir" t))
  200. (process-environment (cons (concat "TMPDIR=" tempdir)
  201. process-environment)))
  202. (unwind-protect
  203. (with-temp-buffer
  204. (with-temp-file pdffile
  205. (set-buffer-multibyte nil)
  206. (insert pdf-info-empty-page-data))
  207. (with-temp-file cmdfile
  208. (insert (format "renderpage:%s:1:100\nquit\n"
  209. (pdf-info-query--escape pdffile))))
  210. (unless (= 0 (apply #'call-process
  211. executable cmdfile (current-buffer)
  212. nil (when pdf-info-epdfinfo-error-filename
  213. (list pdf-info-epdfinfo-error-filename))))
  214. (error "Error running `%s': %s"
  215. pdf-info-epdfinfo-program
  216. (buffer-string))))
  217. (when (file-exists-p cmdfile)
  218. (delete-file cmdfile))
  219. (when (file-exists-p pdffile)
  220. (delete-file pdffile))
  221. (when (file-exists-p tempdir)
  222. (delete-directory tempdir t)))))
  223. (when interactive-p
  224. (message "The epdfinfo program appears to be working."))
  225. nil)
  226. (defun pdf-info-process-assert-running (&optional force)
  227. "Assert a running process.
  228. If it never ran, i.e. `pdf-info-process' is t, start it
  229. unconditionally.
  230. Otherwise, if FORCE is non-nil start it, if it is not running.
  231. Else restart it with respect to the variable
  232. `pdf-info-restart-process-p', which see.
  233. If getting the process to run fails, this function throws an
  234. error."
  235. (interactive "P")
  236. (unless (and (processp (pdf-info-process))
  237. (eq (process-status (pdf-info-process))
  238. 'run))
  239. (when (pdf-info-process)
  240. (tq-close pdf-info--queue)
  241. (setq pdf-info--queue nil))
  242. (unless (or force
  243. (eq pdf-info--queue t)
  244. (and (eq pdf-info-restart-process-p 'ask)
  245. (not noninteractive)
  246. (y-or-n-p "The epdfinfo server quit, restart it ? "))
  247. (and pdf-info-restart-process-p
  248. (not (eq pdf-info-restart-process-p 'ask))))
  249. (when (eq pdf-info-restart-process-p 'ask)
  250. (setq pdf-info-restart-process-p nil))
  251. (error "The epdfinfo server quit"))
  252. (pdf-info-check-epdfinfo)
  253. (let* ((process-connection-type) ;Avoid 4096 Byte bug #12440.
  254. (default-directory "~")
  255. (proc (apply #'start-process
  256. "epdfinfo" " *epdfinfo*" pdf-info-epdfinfo-program
  257. (when pdf-info-epdfinfo-error-filename
  258. (list pdf-info-epdfinfo-error-filename)))))
  259. (with-current-buffer " *epdfinfo*"
  260. (erase-buffer))
  261. (set-process-query-on-exit-flag proc nil)
  262. (set-process-coding-system proc 'utf-8-unix 'utf-8-unix)
  263. (setq pdf-info--queue (tq-create proc))))
  264. pdf-info--queue)
  265. (defadvice tq-process-buffer (around bugfix activate)
  266. "Fix a bug in trunk where the wrong callback gets called."
  267. ;; FIXME: Make me iterative.
  268. (let ((tq (ad-get-arg 0)))
  269. (if (not (equal (car (process-command (tq-process tq)))
  270. pdf-info-epdfinfo-program))
  271. ad-do-it
  272. (let ((buffer (tq-buffer tq))
  273. done)
  274. (when (buffer-live-p buffer)
  275. (set-buffer buffer)
  276. (while (and (not done)
  277. (> (buffer-size) 0))
  278. (setq done t)
  279. (if (tq-queue-empty tq)
  280. (let ((buf (generate-new-buffer "*spurious*")))
  281. (copy-to-buffer buf (point-min) (point-max))
  282. (delete-region (point-min) (point))
  283. (pop-to-buffer buf nil)
  284. (error "Spurious communication from process %s, see buffer %s"
  285. (process-name (tq-process tq))
  286. (buffer-name buf)))
  287. (goto-char (point-min))
  288. (when (re-search-forward (tq-queue-head-regexp tq) nil t)
  289. (setq done nil)
  290. (let ((answer (buffer-substring (point-min) (point)))
  291. (fn (tq-queue-head-fn tq))
  292. (closure (tq-queue-head-closure tq)))
  293. (delete-region (point-min) (point))
  294. (tq-queue-pop tq)
  295. (condition-case-unless-debug err
  296. (funcall fn closure answer)
  297. (error
  298. (message "Error while processing tq callback: %s"
  299. (error-message-string err)))))))))))))
  300. ;; * ================================================================== *
  301. ;; * Sending and receiving
  302. ;; * ================================================================== *
  303. (defun pdf-info-query (cmd &rest args)
  304. "Query the server using CMD and ARGS."
  305. (pdf-info-process-assert-running)
  306. (unless (symbolp cmd)
  307. (setq cmd (intern cmd)))
  308. (let* ((query (concat (mapconcat 'pdf-info-query--escape
  309. (cons cmd args) ":") "\n"))
  310. (callback
  311. (lambda (closure response)
  312. (cl-destructuring-bind (status &rest result)
  313. (pdf-info-query--parse-response cmd response)
  314. (pdf-info-query--log response)
  315. (let* (pdf-info-asynchronous)
  316. (if (functionp closure)
  317. (funcall closure status result)
  318. (apply (car closure) status result (cdr closure)))))))
  319. response status done
  320. (closure (or pdf-info-asynchronous
  321. (lambda (s r)
  322. (setq status s response r done t)))))
  323. (pdf-info-query--log query t)
  324. (tq-enqueue
  325. pdf-info--queue query "^\\.\n" closure callback)
  326. (unless pdf-info-asynchronous
  327. (while (and (not done)
  328. (eq (process-status (pdf-info-process))
  329. 'run))
  330. (accept-process-output (pdf-info-process) 0.01))
  331. (when (and (not done)
  332. (not (eq (process-status (pdf-info-process))
  333. 'run))
  334. (not (eq cmd 'quit)))
  335. (error "The epdfinfo server quit unexpectedly."))
  336. (cond
  337. ((null status) response)
  338. ((eq status 'error)
  339. (error "epdfinfo: %s" response))
  340. ((eq status 'interrupted)
  341. (error "epdfinfo: Command was interrupted"))
  342. (t
  343. (error "internal error: invalid response status"))))))
  344. (defun pdf-info-interrupt ()
  345. "FIXME: This command does currently nothing."
  346. (when (and (processp (pdf-info-process))
  347. (eq (process-status (pdf-info-process))
  348. 'run))
  349. (signal-process (pdf-info-process) 'SIGUSR1)))
  350. (defun pdf-info-query--escape (arg)
  351. "Escape ARG for transmission to the server."
  352. (if (null arg)
  353. (string)
  354. (with-current-buffer (get-buffer-create " *pdf-info-query--escape*")
  355. (erase-buffer)
  356. (insert (format "%s" arg))
  357. (goto-char 1)
  358. (while (not (eobp))
  359. (cond
  360. ((memq (char-after) '(?\\ ?:))
  361. (insert ?\\))
  362. ((eq (char-after) ?\n)
  363. (delete-char 1)
  364. (insert ?\\ ?n)
  365. (backward-char)))
  366. (forward-char))
  367. (buffer-substring-no-properties 1 (point-max)))))
  368. (defmacro pdf-info-query--read-record ()
  369. "Read a single record of the response in current buffer."
  370. `(let (records done (beg (point)))
  371. (while (not done)
  372. (cl-case (char-after)
  373. (?\\
  374. (delete-char 1)
  375. (if (not (eq (char-after) ?n))
  376. (forward-char)
  377. (delete-char 1)
  378. (insert ?\n)))
  379. ((?: ?\n)
  380. (push (buffer-substring-no-properties
  381. beg (point)) records)
  382. (forward-char)
  383. (setq beg (point)
  384. done (bolp)))
  385. (t (forward-char))))
  386. (nreverse records)))
  387. (defun pdf-info-query--parse-response (cmd response)
  388. "Parse one epdfinfo RESPONSE to CMD.
  389. Returns a cons \(STATUS . RESULT\), where STATUS is one of nil
  390. for a regular response, error for an error \(RESULT contains the
  391. error message\) or interrupted, i.e. the command was
  392. interrupted."
  393. (with-current-buffer
  394. (get-buffer-create " *pdf-info-query--parse-response*")
  395. (erase-buffer)
  396. (insert response)
  397. (goto-char 1)
  398. (cond
  399. ((looking-at "ERR\n")
  400. (forward-line)
  401. (cons 'error (buffer-substring-no-properties
  402. (point)
  403. (progn
  404. (re-search-forward "^\\.\n")
  405. (1- (match-beginning 0))))))
  406. ((looking-at "OK\n")
  407. (let (result)
  408. (forward-line)
  409. (while (not (and (= (char-after) ?.)
  410. (= (char-after (1+ (point))) ?\n)))
  411. (push (pdf-info-query--read-record) result))
  412. (cons nil (pdf-info-query--transform-response
  413. cmd (nreverse result)))))
  414. ((looking-at "INT\n")
  415. (cons 'interrupted nil))
  416. (t
  417. (cons 'error "Invalid server response")))))
  418. (defun pdf-info-query--transform-response (cmd response)
  419. "Transform a RESPONSE to CMD into a Lisp form."
  420. (cl-case cmd
  421. (open nil)
  422. (close (equal "1" (caar response)))
  423. (number-of-pages (string-to-number (caar response)))
  424. (charlayout
  425. (mapcar (lambda (elt)
  426. (cl-assert (= 1 (length (cadr elt))) t)
  427. `(,(aref (cadr elt) 0)
  428. ,(mapcar 'string-to-number
  429. (split-string (car elt) " " t))))
  430. response))
  431. (regexp-flags
  432. (mapcar (lambda (elt)
  433. (cons (intern (car elt))
  434. (string-to-number (cadr elt))))
  435. response))
  436. ((search-string search-regexp)
  437. (mapcar
  438. (lambda (r)
  439. `((page . ,(string-to-number (nth 0 r)))
  440. (text . ,(let (case-fold-search)
  441. (pdf-util-highlight-regexp-in-string
  442. (regexp-quote (nth 1 r)) (nth 2 r))))
  443. (edges . ,(mapcar (lambda (m)
  444. (mapcar 'string-to-number
  445. (split-string m " " t)))
  446. (cddr (cdr r))))))
  447. response))
  448. (outline
  449. (mapcar (lambda (r)
  450. `((depth . ,(string-to-number (pop r)))
  451. ,@(pdf-info-query--transform-action r)))
  452. response))
  453. (pagelinks
  454. (mapcar (lambda (r)
  455. `((edges .
  456. ,(mapcar 'string-to-number ;area
  457. (split-string (pop r) " " t)))
  458. ,@(pdf-info-query--transform-action r)))
  459. response))
  460. (metadata
  461. (let ((md (car response)))
  462. (if (= 1 (length md))
  463. (list (cons 'title (car md)))
  464. (list
  465. (cons 'title (pop md))
  466. (cons 'author (pop md))
  467. (cons 'subject (pop md))
  468. (cons 'keywords-raw (car md))
  469. (cons 'keywords (split-string (pop md) "[\t\n ]*,[\t\n ]*" t))
  470. (cons 'creator (pop md))
  471. (cons 'producer (pop md))
  472. (cons 'format (pop md))
  473. (cons 'created (pop md))
  474. (cons 'modified (pop md))))))
  475. (gettext
  476. (or (caar response) ""))
  477. (getselection
  478. (mapcar (lambda (line)
  479. (mapcar 'string-to-number
  480. (split-string (car line) " " t)))
  481. response))
  482. (features (mapcar 'intern (car response)))
  483. (pagesize
  484. (setq response (car response))
  485. (cons (round (string-to-number (car response)))
  486. (round (string-to-number (cadr response)))))
  487. ((getannot editannot addannot)
  488. (pdf-info-query--transform-annotation (car response)))
  489. (getannots
  490. (mapcar 'pdf-info-query--transform-annotation response))
  491. (getattachments
  492. (mapcar 'pdf-info-query--transform-attachment response))
  493. ((getattachment-from-annot)
  494. (pdf-info-query--transform-attachment (car response)))
  495. (boundingbox
  496. (mapcar 'string-to-number (car response)))
  497. (synctex-forward-search
  498. (let ((list (mapcar 'string-to-number (car response))))
  499. `((page . ,(car list))
  500. (edges . ,(cdr list)))))
  501. (synctex-backward-search
  502. `((filename . ,(caar response))
  503. (line . ,(string-to-number (cadr (car response))))
  504. (column . ,(string-to-number (cadr (cdar response))))))
  505. (delannot nil)
  506. ((save) (caar response))
  507. ((renderpage renderpage-text-regions renderpage-highlight)
  508. (pdf-util-munch-file (caar response)))
  509. ((setoptions getoptions)
  510. (let (options)
  511. (dolist (key-value response)
  512. (let ((key (intern (car key-value)))
  513. (value (cadr key-value)))
  514. (cl-case key
  515. ((:render/printed :render/usecolors)
  516. (setq value (equal value "1"))))
  517. (push value options)
  518. (push key options)))
  519. options))
  520. (pagelabels (mapcar 'car response))
  521. (ping (caar response))
  522. (t response)))
  523. (defun pdf-info-query--transform-action (action)
  524. "Transform ACTION response into a Lisp form."
  525. (let ((type (intern (pop action))))
  526. `((type . ,type)
  527. (title . ,(pop action))
  528. ,@(cl-case type
  529. (goto-dest
  530. `((page . ,(string-to-number (pop action)))
  531. (top . ,(and (> (length (car action)) 0)
  532. (string-to-number (pop action))))))
  533. (goto-remote
  534. `((filename . ,(pop action))
  535. (page . ,(string-to-number (pop action)))
  536. (top . ,(and (> (length (car action)) 0)
  537. (string-to-number (pop action))))))
  538. (t `((uri . ,(pop action))))))))
  539. (defun pdf-info-query--transform-annotation (a)
  540. (cl-labels ((not-empty (s)
  541. (if (not (equal s "")) s)))
  542. (let (a1 a2 a3)
  543. (cl-destructuring-bind (page edges type id flags color contents modified &rest rest)
  544. a
  545. (setq a1 `((page . ,(string-to-number page))
  546. (edges . ,(mapcar 'string-to-number
  547. (split-string edges " " t)))
  548. (type . ,(intern type))
  549. (id . ,(intern id))
  550. (flags . ,(string-to-number flags))
  551. (color . ,(not-empty color))
  552. (contents . ,contents)
  553. (modified . ,(pdf-info-parse-pdf-date modified))))
  554. (when rest
  555. (cl-destructuring-bind (label subject opacity popup-edges popup-is-open created
  556. &rest rest)
  557. rest
  558. (setq a2
  559. `((label . ,(not-empty label))
  560. (subject . ,(not-empty subject))
  561. (opacity . ,(let ((o (not-empty opacity)))
  562. (and o (string-to-number o))))
  563. (popup-edges . ,(let ((p (not-empty popup-edges)))
  564. (when p
  565. (mapcar 'string-to-number
  566. (split-string p " " t)))))
  567. (popup-is-open . ,(equal popup-is-open "1"))
  568. (created . ,(pdf-info-parse-pdf-date (not-empty created)))))
  569. (cond
  570. ((eq (cdr (assoc 'type a1)) 'text)
  571. (cl-destructuring-bind (icon state is-open)
  572. rest
  573. (setq a3
  574. `((icon . ,(not-empty icon))
  575. (state . ,(not-empty state))
  576. (is-open . ,(equal is-open "1"))))))
  577. ((memq (cdr (assoc 'type a1))
  578. '(squiggly highlight underline strike-out))
  579. (setq a3 `((markup-edges
  580. . ,(mapcar (lambda (r)
  581. (mapcar 'string-to-number
  582. (split-string r " " t)))
  583. rest)))))))))
  584. (append a1 a2 a3))))
  585. (defun pdf-info-query--transform-attachment (a)
  586. (cl-labels ((not-empty (s)
  587. (if (not (equal s "")) s)))
  588. (cl-destructuring-bind (id filename description size modified
  589. created checksum file)
  590. a
  591. `((id . ,(intern id))
  592. (filename . ,(not-empty filename))
  593. (description . ,(not-empty description))
  594. (size . ,(let ((n (string-to-number size)))
  595. (and (>= n 0) n)))
  596. (modified . ,(not-empty modified))
  597. (created . ,(not-empty created))
  598. (checksum . ,(not-empty checksum))
  599. (file . ,(not-empty file))))))
  600. (defun pdf-info-query--log (string &optional query-p)
  601. "Log STRING as query/response, depending on QUERY-P.
  602. This is a no-op, if `pdf-info-log' is nil."
  603. (when pdf-info-log
  604. (with-current-buffer (get-buffer-create "*pdf-info-log*")
  605. (buffer-disable-undo)
  606. (let ((pos (point-max))
  607. (window (get-buffer-window)))
  608. (save-excursion
  609. (goto-char (point-max))
  610. (unless (bolp)
  611. (insert ?\n))
  612. (insert
  613. (propertize
  614. (format-time-string "%H:%M:%S ")
  615. 'face
  616. (if query-p
  617. 'font-lock-keyword-face
  618. 'font-lock-function-name-face))
  619. (if (and (numberp pdf-info-log-entry-max)
  620. (> (length string)
  621. pdf-info-log-entry-max))
  622. (concat (substring string 0 pdf-info-log-entry-max)
  623. "...[truncated]\n")
  624. string)))
  625. (when (and (window-live-p window)
  626. (= pos (window-point window)))
  627. (set-window-point window (point-max)))))))
  628. ;; * ================================================================== *
  629. ;; * Utility functions
  630. ;; * ================================================================== *
  631. (defvar doc-view-buffer-file-name)
  632. (defvar doc-view--buffer-file-name)
  633. (defun pdf-info--normalize-file-or-buffer (file-or-buffer)
  634. "Return the PDF file corresponding to FILE-OR-BUFFER.
  635. FILE-OR-BUFFER may be nil, a PDF buffer, the name of a PDF buffer
  636. or a PDF file."
  637. (unless file-or-buffer
  638. (setq file-or-buffer
  639. (current-buffer)))
  640. (when (bufferp file-or-buffer)
  641. (unless (buffer-live-p file-or-buffer)
  642. (error "Buffer is not live :%s" file-or-buffer))
  643. (with-current-buffer file-or-buffer
  644. (unless (setq file-or-buffer
  645. (cl-case major-mode
  646. (doc-view-mode
  647. (cond ((boundp 'doc-view-buffer-file-name)
  648. doc-view-buffer-file-name)
  649. ((boundp 'doc-view--buffer-file-name)
  650. doc-view--buffer-file-name)))
  651. (pdf-view-mode (pdf-view-buffer-file-name))
  652. (t (buffer-file-name))))
  653. (error "Buffer is not associated with any file :%s" (buffer-name)))))
  654. (unless (stringp file-or-buffer)
  655. (signal 'wrong-type-argument
  656. (list 'stringp 'bufferp 'null file-or-buffer)))
  657. ;; is file
  658. (when (file-remote-p file-or-buffer)
  659. (error "Processing remote files not supported :%s"
  660. file-or-buffer))
  661. ;; (unless (file-readable-p file-or-buffer)
  662. ;; (error "File not readable :%s" file-or-buffer))
  663. (expand-file-name file-or-buffer))
  664. (defun pdf-info-valid-page-spec-p (pages)
  665. "The type predicate for a valid page-spec."
  666. (not (not (ignore-errors (pdf-info-normalize-page-range pages)))))
  667. (defun pdf-info-normalize-page-range (pages)
  668. "Normalize PAGES for sending to the server.
  669. PAGES may be a single page number, a cons \(FIRST . LAST\), or
  670. nil, which stands for all pages.
  671. The result is a cons \(FIRST . LAST\), where LAST may be 0
  672. representing the final page."
  673. (cond
  674. ((natnump pages)
  675. (cons pages pages))
  676. ((null pages)
  677. (cons 1 0))
  678. ((and (natnump (car pages))
  679. (natnump (cdr pages)))
  680. pages)
  681. (t
  682. (signal 'wrong-type-argument
  683. (list 'pdf-info-valid-page-spec-p pages)))))
  684. (defun pdf-info-parse-pdf-date (date)
  685. (when (and date
  686. (string-match pdf-info-pdf-date-regexp date))
  687. (let ((year (match-string 1 date))
  688. (month (match-string 2 date))
  689. (day (match-string 3 date))
  690. (hour (match-string 4 date))
  691. (min (match-string 5 date))
  692. (sec (match-string 6 date))
  693. (ut-char (match-string 7 date))
  694. (ut-hour (match-string 8 date))
  695. (ut-min (match-string 9 date))
  696. (tz 0))
  697. (when (or (equal ut-char "+")
  698. (equal ut-char "-"))
  699. (when ut-hour
  700. (setq tz (* 3600 (string-to-number ut-hour))))
  701. (when ut-min
  702. (setq tz (+ tz (* 60 (string-to-number ut-min)))))
  703. (when (equal ut-char "-")
  704. (setq tz (- tz))))
  705. (encode-time
  706. (if sec (string-to-number sec) 0)
  707. (if min (string-to-number min) 0)
  708. (if hour (string-to-number hour) 0)
  709. (if day (string-to-number day) 1)
  710. (if month (string-to-number month) 1)
  711. (string-to-number year)
  712. tz))))
  713. (defmacro pdf-info-compose-queries (let-forms &rest body)
  714. "Let-bind each VAR to QUERIES results and evaluate BODY.
  715. All queries in each QUERIES form are run by the server in the
  716. order they appear and the results collected in a list, which is
  717. bound to VAR. Then BODY is evaluated and its value becomes the
  718. final result of all queries, unless at least one of them provoked
  719. an error. In this case BODY is ignored and the error is the
  720. result.
  721. This macro handles synchronous and asynchronous calls,
  722. i.e. `pdf-info-asynchronous' is non-nil, transparently.
  723. \(FN \(\(VAR QUERIES\)...\) BODY\)"
  724. (declare (indent 1)
  725. (debug ((&rest &or
  726. (symbolp &optional form)
  727. symbolp)
  728. body)))
  729. (unless (cl-every (lambda (form)
  730. (when (symbolp form)
  731. (setq form (list form)))
  732. (and (consp form)
  733. (symbolp (car form))
  734. (listp (cdr form))))
  735. let-forms)
  736. (error "Invalid let-form: %s" let-forms))
  737. (setq let-forms (mapcar (lambda (form)
  738. (if (symbolp form)
  739. (list form)
  740. form))
  741. let-forms))
  742. (let* ((status (make-symbol "status"))
  743. (response (make-symbol "response"))
  744. (first-error (make-symbol "first-error"))
  745. (done (make-symbol "done"))
  746. (callback (make-symbol "callback"))
  747. (results (make-symbol "results"))
  748. (push-fn (make-symbol "push-fn"))
  749. (terminal-fn (make-symbol "terminal-fn"))
  750. (buffer (make-symbol "buffer")))
  751. `(let* (,status
  752. ,response ,first-error ,done
  753. (,buffer (current-buffer))
  754. (,callback pdf-info-asynchronous)
  755. ;; Ensure a new alist on every invocation.
  756. (,results (mapcar 'copy-sequence
  757. ',(cl-mapcar (lambda (form)
  758. (list (car form)))
  759. let-forms)))
  760. (,push-fn (lambda (status result var)
  761. ;; Store result in alist RESULTS under key
  762. ;; VAR.
  763. (if status
  764. (unless ,first-error
  765. (setq ,first-error result))
  766. (let ((elt (assq var ,results)))
  767. (setcdr elt (append (cdr elt)
  768. (list result)))))))
  769. (,terminal-fn
  770. (lambda (&rest _)
  771. ;; Let-bind responses corresponding to their variables,
  772. ;; i.e. keys in alist RESULTS.
  773. (let (,@(mapcar (lambda (var)
  774. (list var (list 'cdr (list 'assq (list 'quote var)
  775. results))))
  776. (mapcar 'car let-forms)))
  777. (setq ,status (not (not ,first-error))
  778. ,response (or ,first-error
  779. (with-current-buffer ,buffer
  780. ,@body))
  781. ,done t)
  782. ;; Maybe invoke the CALLBACK (which was bound to
  783. ;; pdf-info-asynchronous).
  784. (when ,callback
  785. (if (functionp ,callback)
  786. (funcall ,callback ,status ,response)
  787. (apply (car ,callback)
  788. ,status ,response (cdr ,callback))))))))
  789. ;; Wrap each query in an asynchronous call, with its VAR as
  790. ;; callback argument, so the PUSH-FN can put it in the alist
  791. ;; RESULTS.
  792. ,@(mapcar (lambda (form)
  793. (list 'let (list
  794. (list 'pdf-info-asynchronous
  795. (list 'list push-fn (list 'quote (car form)))))
  796. (cadr form)))
  797. let-forms)
  798. ;; Request a no-op, just so we know that we are finished.
  799. (let ((pdf-info-asynchronous ,terminal-fn))
  800. (pdf-info-ping))
  801. ;; CALLBACK is the original value of pdf-info-asynchronous. If
  802. ;; nil, this is a synchronous query.
  803. (unless ,callback
  804. (while (and (not ,done)
  805. (eq (process-status (pdf-info-process))
  806. 'run))
  807. (accept-process-output (pdf-info-process) 0.01))
  808. (when (and (not ,done)
  809. (not (eq (process-status (pdf-info-process))
  810. 'run)))
  811. (error "The epdfinfo server quit unexpectedly."))
  812. (when ,status
  813. (error "epdfinfo: %s" ,response))
  814. ,response))))
  815. ;; * ================================================================== *
  816. ;; * Buffer local server instances
  817. ;; * ================================================================== *
  818. (put 'pdf-info--queue 'permanent-local t)
  819. (defun pdf-info-make-local-server (&optional buffer force-restart-p)
  820. "Create a server instance local to BUFFER.
  821. Does nothing if BUFFER already has a local instance. Unless
  822. FORCE-RESTART-P is non-nil, then quit a potential process and
  823. restart it."
  824. (unless buffer
  825. (setq buffer (current-buffer)))
  826. (with-current-buffer buffer
  827. (unless (and
  828. (not force-restart-p)
  829. (local-variable-p 'pdf-info--queue)
  830. (processp (pdf-info-process))
  831. (eq (process-status (pdf-info-process))
  832. 'run))
  833. (when (and (local-variable-p 'pdf-info--queue)
  834. (processp (pdf-info-process)))
  835. (tq-close pdf-info--queue))
  836. (set (make-local-variable 'pdf-info--queue) nil)
  837. (pdf-info-process-assert-running t)
  838. (add-hook 'kill-buffer-hook 'pdf-info-kill-local-server nil t)
  839. pdf-info--queue)))
  840. (defun pdf-info-kill-local-server (&optional buffer)
  841. "Kill the local server in BUFFER.
  842. A No-op, if BUFFER has not running server instance."
  843. (save-current-buffer
  844. (when buffer
  845. (set-buffer buffer))
  846. (when (local-variable-p 'pdf-info--queue)
  847. (pdf-info-kill)
  848. (kill-local-variable 'pdf-info--queue)
  849. t)))
  850. (defun pdf-info-local-server-p (&optional buffer)
  851. "Return non-nil, if BUFFER has a running server instance."
  852. (unless buffer
  853. (setq buffer (current-buffer)))
  854. (setq buffer (get-buffer buffer))
  855. (and (buffer-live-p buffer)
  856. (local-variable-p 'pdf-info--queue buffer)))
  857. (defun pdf-info-local-batch-query (producer-fn
  858. consumer-fn
  859. sentinel-fn
  860. args)
  861. "Process a set of queries asynchronously in a local instance."
  862. (unless (pdf-info-local-server-p)
  863. (error "Create a local server first"))
  864. (let* ((buffer (current-buffer))
  865. (producer-symbol (make-symbol "producer"))
  866. (consumer-symbol (make-symbol "consumer"))
  867. (producer
  868. (lambda (args)
  869. (if (null args)
  870. (funcall sentinel-fn 'finished buffer)
  871. (let ((pdf-info-asynchronous
  872. (apply-partially
  873. (symbol-function consumer-symbol)
  874. args)))
  875. (cond
  876. ((pdf-info-local-server-p buffer)
  877. (with-current-buffer buffer
  878. (apply producer-fn (car args))))
  879. (t
  880. (funcall sentinel-fn 'error buffer)))))))
  881. (consumer (lambda (args status result)
  882. (if (not (pdf-info-local-server-p buffer))
  883. (funcall sentinel-fn 'error buffer)
  884. (with-current-buffer buffer
  885. (apply consumer-fn status result (car args)))
  886. (funcall (symbol-function producer-symbol)
  887. (cdr args))))))
  888. (fset producer-symbol producer)
  889. (fset consumer-symbol consumer)
  890. (funcall producer args)))
  891. ;; * ================================================================== *
  892. ;; * High level interface
  893. ;; * ================================================================== *
  894. (defvar pdf-info-features nil)
  895. (defun pdf-info-features ()
  896. "Return a list of symbols describing compile-time features."
  897. (or pdf-info-features
  898. (setq pdf-info-features
  899. (let (pdf-info-asynchronous)
  900. (pdf-info-query 'features)))))
  901. (defun pdf-info-writable-annotations-p ()
  902. (not (null (memq 'writable-annotations (pdf-info-features)))))
  903. (defun pdf-info-markup-annotations-p ()
  904. (not (null (memq 'markup-annotations (pdf-info-features)))))
  905. (defmacro pdf-info-assert-writable-annotations ()
  906. `(unless (memq 'writable-annotations (pdf-info-features))
  907. (error "Writing annotations is not supported by this version of epdfinfo")))
  908. (defmacro pdf-info-assert-markup-annotations ()
  909. `(unless (memq 'markup-annotations (pdf-info-features))
  910. (error "Creating markup annotations is not supported by this version of epdfinfo")))
  911. (defun pdf-info-creatable-annotation-types ()
  912. (let ((features (pdf-info-features)))
  913. (cond
  914. ((not (memq 'writable-annotations features)) nil)
  915. ((memq 'markup-annotations features)
  916. (list 'text 'squiggly 'underline 'strike-out 'highlight))
  917. (t (list 'text)))))
  918. (defun pdf-info-open (&optional file-or-buffer password)
  919. "Open the document FILE-OR-BUFFER using PASSWORD.
  920. Generally, documents are opened and closed automatically on
  921. demand, so this function is rarely needed, unless a PASSWORD is
  922. set on the document.
  923. Manually opened documents are never closed automatically."
  924. (pdf-info-query
  925. 'open (pdf-info--normalize-file-or-buffer file-or-buffer)
  926. password))
  927. (defun pdf-info-close (&optional file-or-buffer)
  928. "Close the document FILE-OR-BUFFER.
  929. Returns t, if the document was actually open, otherwise nil.
  930. This command is rarely needed, see also `pdf-info-open'."
  931. (let* ((pdf (pdf-info--normalize-file-or-buffer file-or-buffer))
  932. (buffer (find-buffer-visiting pdf)))
  933. (prog1
  934. (pdf-info-query 'close pdf)
  935. (if (buffer-live-p buffer)
  936. (with-current-buffer buffer
  937. (run-hooks 'pdf-info-close-document-hook))
  938. (with-temp-buffer
  939. (run-hooks 'pdf-info-close-document-hook))))))
  940. (defun pdf-info-encrypted-p (&optional file-or-buffer)
  941. "Return non-nil if FILE-OR-BUFFER requires a password.
  942. Note: This function returns nil, if the document is encrypted,
  943. but was already opened (presumably using a password)."
  944. (condition-case err
  945. (pdf-info-open
  946. (pdf-info--normalize-file-or-buffer file-or-buffer))
  947. (error (or (string-match-p
  948. ":Document is encrypted\\'" (cadr err))
  949. (signal (car err) (cdr err))))))
  950. (defun pdf-info-metadata (&optional file-or-buffer)
  951. "Extract the metadata from the document FILE-OR-BUFFER.
  952. This returns an alist containing some information about the
  953. document."
  954. (pdf-info-query
  955. 'metadata
  956. (pdf-info--normalize-file-or-buffer file-or-buffer)))
  957. (defun pdf-info-search-string (string &optional pages file-or-buffer)
  958. "Search for STRING in PAGES of document FILE-OR-BUFFER.
  959. See `pdf-info-normalize-page-range' for valid PAGES formats.
  960. This function returns a list of matches. Each item is an alist
  961. containing keys PAGE, TEXT and EDGES, where PAGE and TEXT are the
  962. matched page resp. line. EDGES is a list containing a single
  963. edges element \(LEFT TOP RIGHT BOTTOM\). This is for consistency
  964. with `pdf-info-search-regexp', which may return matches with
  965. multiple edges.
  966. The TEXT contains `match' face properties on the matched parts.
  967. Search is case-insensitive, unless `case-fold-search' is nil and
  968. searching case-sensitive is supported by the server."
  969. (let ((pages (pdf-info-normalize-page-range pages)))
  970. (pdf-info-query
  971. 'search-string
  972. (pdf-info--normalize-file-or-buffer file-or-buffer)
  973. (car pages)
  974. (cdr pages)
  975. string
  976. (if case-fold-search 1 0))))
  977. (defvar pdf-info-regexp-compile-flags nil
  978. "PCRE compile flags.
  979. Don't use this, but the equally named function.")
  980. (defvar pdf-info-regexp-match-flags nil
  981. "PCRE match flags.
  982. Don't use this, but the equally named function.")
  983. (defun pdf-info-regexp-compile-flags ()
  984. (or pdf-info-regexp-compile-flags
  985. (let* (pdf-info-asynchronous
  986. (flags (pdf-info-query 'regexp-flags))
  987. (match (cl-remove-if-not
  988. (lambda (flag)
  989. (string-match-p
  990. "\\`match-" (symbol-name (car flag))))
  991. flags))
  992. (compile (cl-set-difference flags match)))
  993. (setq pdf-info-regexp-compile-flags compile
  994. pdf-info-regexp-match-flags match)
  995. pdf-info-regexp-compile-flags)))
  996. (defun pdf-info-regexp-match-flags ()
  997. (or pdf-info-regexp-match-flags
  998. (progn
  999. (pdf-info-regexp-compile-flags)
  1000. pdf-info-regexp-match-flags)))
  1001. (defvar pdf-info-regexp-flags '(multiline)
  1002. "Compile- and match-flags for the PCRE engine.
  1003. This is a list of symbols denoting compile- and match-flags when
  1004. searching for regular expressions.
  1005. You should not change this directly, but rather `let'-bind it
  1006. around a call to `pdf-info-search-regexp'.
  1007. Valid compile-flags are:
  1008. newline-crlf, newline-lf, newline-cr, dupnames, optimize,
  1009. no-auto-capture, raw, ungreedy, dollar-endonly, anchored,
  1010. extended, dotall, multiline and caseless.
  1011. Note that the last one, caseless, is handled special, as it is
  1012. always added if `case-fold-search' is non-nil.
  1013. And valid match-flags:
  1014. match-anchored, match-notbol, match-noteol, match-notempty,
  1015. match-partial, match-newline-cr, match-newline-lf,
  1016. match-newline-crlf and match-newline-any.
  1017. See the glib documentation at url
  1018. `https://developer.gnome.org/glib/stable/glib-Perl-compatible-regular-expressions.html'.")
  1019. (defun pdf-info-search-regexp (pcre &optional pages
  1020. no-error
  1021. file-or-buffer)
  1022. "Search for a PCRE on PAGES of document FILE-OR-BUFFER.
  1023. See `pdf-info-normalize-page-range' for valid PAGES formats and
  1024. `pdf-info-search-string' for its return value.
  1025. Uses the flags in `pdf-info-regexp-flags', which see. If
  1026. `case-fold-search' is non-nil, the caseless flag is added.
  1027. If NO-ERROR is non-nil, catch errors due to invalid regexps and
  1028. return nil. If it is the symbol `invalid-regexp', then re-signal
  1029. this kind of error as a `invalid-regexp' error."
  1030. (cl-labels ((orflags (flags alist)
  1031. (cl-reduce
  1032. (lambda (v flag)
  1033. (let ((n
  1034. (cdr (assq flag alist))))
  1035. (if n (logior n v) v)))
  1036. (cons 0 flags))))
  1037. (let ((pages (pdf-info-normalize-page-range pages)))
  1038. (condition-case err
  1039. (pdf-info-query
  1040. 'search-regexp
  1041. (pdf-info--normalize-file-or-buffer file-or-buffer)
  1042. (car pages)
  1043. (cdr pages)
  1044. pcre
  1045. (orflags `(,(if case-fold-search
  1046. 'caseless)
  1047. ,@pdf-info-regexp-flags)
  1048. (pdf-info-regexp-compile-flags))
  1049. (orflags pdf-info-regexp-flags
  1050. (pdf-info-regexp-match-flags)))
  1051. (error
  1052. (let ((re
  1053. (concat "\\`epdfinfo: *Invalid *regexp: *"
  1054. ;; glib error
  1055. "\\(?:Error while compiling regular expression"
  1056. " *%s *\\)?\\(.*\\)")))
  1057. (if (or (null no-error)
  1058. (not (string-match
  1059. (format re (regexp-quote pcre))
  1060. (cadr err))))
  1061. (signal (car err) (cdr err))
  1062. (if (eq no-error 'invalid-regexp)
  1063. (signal 'invalid-regexp
  1064. (list (match-string 1 (cadr err))))))))))))
  1065. (defun pdf-info-pagelinks (page &optional file-or-buffer)
  1066. "Return a list of links on PAGE in document FILE-OR-BUFFER.
  1067. This function returns a list of alists with the following keys.
  1068. EDGES represents the relative bounding-box of the link , TYPE is
  1069. the type of the action, TITLE is a, possibly empty, name for this
  1070. action.
  1071. TYPE may be one of
  1072. goto-dest -- This is a internal link to some page. Each element
  1073. contains additional keys PAGE and TOP, where PAGE is the page of
  1074. the link and TOP its vertical position.
  1075. goto-remote -- This a external link to some document. Same as
  1076. goto-dest, with an additional FILENAME of the external PDF.
  1077. uri -- A link in form of some URI. Alist contains additional key
  1078. URI.
  1079. In the first two cases, PAGE may be 0 and TOP nil, which means
  1080. these data is unspecified."
  1081. (cl-check-type page natnum)
  1082. (pdf-info-query
  1083. 'pagelinks
  1084. (pdf-info--normalize-file-or-buffer file-or-buffer)
  1085. page))
  1086. (defun pdf-info-number-of-pages (&optional file-or-buffer)
  1087. "Return the number of pages in document FILE-OR-BUFFER."
  1088. (pdf-info-query 'number-of-pages
  1089. (pdf-info--normalize-file-or-buffer
  1090. file-or-buffer)))
  1091. (defun pdf-info-outline (&optional file-or-buffer)
  1092. "Return the PDF outline of document FILE-OR-BUFFER.
  1093. This function returns a list of alists like `pdf-info-pagelinks'.
  1094. Additionally every alist has a DEPTH (>= 1) entry with the depth
  1095. of this element in the tree."
  1096. (pdf-info-query
  1097. 'outline
  1098. (pdf-info--normalize-file-or-buffer file-or-buffer)))
  1099. (defun pdf-info-gettext (page edges &optional selection-style
  1100. file-or-buffer)
  1101. "Get text on PAGE according to EDGES.
  1102. EDGES should contain relative coordinates. The selection may
  1103. extend over multiple lines, which works similar to a Emacs
  1104. region. SELECTION-STYLE may be one of glyph, word or line and
  1105. determines the smallest unit of the selected region.
  1106. Return the text contained in the selection."
  1107. (pdf-info-query
  1108. 'gettext
  1109. (pdf-info--normalize-file-or-buffer file-or-buffer)
  1110. page
  1111. (mapconcat 'number-to-string edges " ")
  1112. (cl-case selection-style
  1113. (glyph 0)
  1114. (word 1)
  1115. (line 2)
  1116. (t 0))))
  1117. (defun pdf-info-getselection (page edges &optional selection-style
  1118. file-or-buffer)
  1119. "Return the edges of the selection EDGES on PAGE.
  1120. Arguments are the same as for `pdf-info-gettext'. Return a list
  1121. of edges corresponding to the text that would be returned by the
  1122. aforementioned function, when called with the same arguments."
  1123. (pdf-info-query
  1124. 'getselection
  1125. (pdf-info--normalize-file-or-buffer file-or-buffer)
  1126. page
  1127. (mapconcat 'number-to-string edges " ")
  1128. (cl-case selection-style
  1129. (glyph 0)
  1130. (word 1)
  1131. (line 2)
  1132. (t 0))))
  1133. (defun pdf-info-textregions (page &optional file-or-buffer)
  1134. "Return a list of edges describing PAGE's text-layout."
  1135. (pdf-info-getselection
  1136. page '(0 0 1 1) 'glyph file-or-buffer))
  1137. (defun pdf-info-charlayout (page &optional edges-or-pos file-or-buffer)
  1138. "Return the layout of characters of PAGE in/at EDGES-OR-POS.
  1139. Returns a list of elements \(CHAR . \(LEFT TOP RIGHT BOT\)\) mapping
  1140. character to their corresponding relative bounding-boxes.
  1141. EDGES-OR-POS may be a region \(LEFT TOP RIGHT BOT\) restricting
  1142. the returned value to include only characters fully contained in
  1143. it. Or a cons \(LEFT . TOP\) which means to only include the
  1144. character at this position. In this case the return value
  1145. contains at most one element."
  1146. ;; FIXME: Actually returns \(CHAR . LEFT ...\).
  1147. (unless edges-or-pos
  1148. (setq edges-or-pos '(0 0 1 1)))
  1149. (when (numberp (cdr edges-or-pos))
  1150. (setq edges-or-pos (list (car edges-or-pos)
  1151. (cdr edges-or-pos)
  1152. -1 -1)))
  1153. (pdf-info-query
  1154. 'charlayout
  1155. (pdf-info--normalize-file-or-buffer file-or-buffer)
  1156. page
  1157. (mapconcat 'number-to-string edges-or-pos " ")))
  1158. (defun pdf-info-pagesize (page &optional file-or-buffer)
  1159. "Return the size of PAGE as a cons \(WIDTH . HEIGHT\)
  1160. The size is in PDF points."
  1161. (pdf-info-query
  1162. 'pagesize
  1163. (pdf-info--normalize-file-or-buffer file-or-buffer)
  1164. page))
  1165. (defun pdf-info-running-p ()
  1166. "Return non-nil, if the server is running."
  1167. (and (processp (pdf-info-process))
  1168. (eq (process-status (pdf-info-process))
  1169. 'run)))
  1170. (defun pdf-info-quit (&optional timeout)
  1171. "Quit the epdfinfo server.
  1172. This blocks until all outstanding requests are answered. Unless
  1173. TIMEOUT is non-nil, in which case we wait at most TIMEOUT seconds
  1174. before killing the server."
  1175. (cl-check-type timeout (or null number))
  1176. (when (pdf-info-running-p)
  1177. (let ((pdf-info-asynchronous
  1178. (if timeout (lambda (&rest _))
  1179. pdf-info-asynchronous)))
  1180. (pdf-info-query 'quit)
  1181. (when timeout
  1182. (setq timeout (+ (float-time) (max 0 timeout)))
  1183. (while (and (pdf-info-running-p)
  1184. (> timeout (float-time)))
  1185. (accept-process-output (pdf-info-process) 0.5 nil t)))))
  1186. (when (processp (pdf-info-process))
  1187. (tq-close pdf-info--queue))
  1188. (setq pdf-info--queue nil))
  1189. (defun pdf-info-kill ()
  1190. "Kill the epdfinfo server.
  1191. Immediately delete the server process, see also `pdf-info-quit',
  1192. for a more sane way to exit the program."
  1193. (when (processp (pdf-info-process))
  1194. (tq-close pdf-info--queue))
  1195. (setq pdf-info--queue nil))
  1196. (defun pdf-info-getannots (&optional pages file-or-buffer)
  1197. "Return the annotations on PAGE.
  1198. See `pdf-info-normalize-page-range' for valid PAGES formats.
  1199. This function returns the annotations for PAGES as a list of
  1200. alists. Each element of this list describes one annotation and
  1201. contains the following keys.
  1202. page - Its page number.
  1203. edges - Its area.
  1204. type - A symbol describing the annotation's type.
  1205. id - A document-wide unique symbol referencing this annotation.
  1206. flags - Its flags, binary encoded.
  1207. color - Its color in standard Emacs notation.
  1208. contents - The text of this annotation.
  1209. modified - The last modification date of this annotation.
  1210. Additionally, if the annotation is a markup annotation, the
  1211. following keys are present.
  1212. label - The annotation's label.
  1213. subject - The subject addressed.
  1214. opacity - The level of relative opacity.
  1215. popup-edges - The edges of a associated popup window or nil.
  1216. popup-is-open - Whether this window should be displayed open.
  1217. created - The date this markup annotation was created.
  1218. If the annotation is also a markup text annotation, the alist
  1219. contains the following keys.
  1220. text-icon - A string describing the purpose of this annotation.
  1221. text-state - A string, e.g. accepted or rejected." ;FIXME: Use symbols ?
  1222. (let ((pages (pdf-info-normalize-page-range pages)))
  1223. (pdf-info-query
  1224. 'getannots
  1225. (pdf-info--normalize-file-or-buffer file-or-buffer)
  1226. (car pages)
  1227. (cdr pages))))
  1228. (defun pdf-info-getannot (id &optional file-or-buffer)
  1229. "Return the annotation for ID.
  1230. ID should be a symbol, which was previously returned in a
  1231. `pdf-info-getannots' query. Signal an error, if an annotation
  1232. with ID is not available.
  1233. See `pdf-info-getannots' for the kind of return value of this
  1234. function."
  1235. (pdf-info-query
  1236. 'getannot
  1237. (pdf-info--normalize-file-or-buffer file-or-buffer)
  1238. id))
  1239. (defun pdf-info-addannot (page edges type &optional file-or-buffer &rest markup-edges)
  1240. "Add a new annotation to PAGE with EDGES of TYPE.
  1241. FIXME: TYPE may be one of `text', `markup-highlight', ... .
  1242. FIXME: -1 = 24
  1243. See `pdf-info-getannots' for the kind of value of this function
  1244. returns."
  1245. (pdf-info-assert-writable-annotations)
  1246. (when (consp file-or-buffer)
  1247. (push file-or-buffer markup-edges)
  1248. (setq file-or-buffer nil))
  1249. (apply
  1250. 'pdf-info-query
  1251. 'addannot
  1252. (pdf-info--normalize-file-or-buffer file-or-buffer)
  1253. page
  1254. type
  1255. (mapconcat 'number-to-string edges " ")
  1256. (mapcar (lambda (me)
  1257. (mapconcat 'number-to-string me " "))
  1258. markup-edges)))
  1259. (defun pdf-info-delannot (id &optional file-or-buffer)
  1260. "Delete the annotation with ID in FILE-OR-BUFFER.
  1261. ID should be a symbol, which was previously returned in a
  1262. `pdf-info-getannots' query. Signal an error, if annotation ID
  1263. does not exist."
  1264. (pdf-info-assert-writable-annotations)
  1265. (pdf-info-query
  1266. 'delannot
  1267. (pdf-info--normalize-file-or-buffer file-or-buffer)
  1268. id))
  1269. (defun pdf-info-mvannot (id edges &optional file-or-buffer)
  1270. "Move/Resize annotation ID to fit EDGES.
  1271. ID should be a symbol, which was previously returned in a
  1272. `pdf-info-getannots' query. Signal an error, if annotation ID
  1273. does not exist.
  1274. EDGES should be a list \(LEFT TOP RIGHT BOT\). RIGHT and/or BOT
  1275. may also be negative, which means to keep the width
  1276. resp. height."
  1277. (pdf-info-editannot id `((edges . ,edges)) file-or-buffer))
  1278. (defun pdf-info-editannot (id modifications &optional file-or-buffer)
  1279. "Edit annotation ID, applying MODIFICATIONS.
  1280. ID should be a symbol, which was previously returned in a
  1281. `pdf-info-getannots' query.
  1282. MODIFICATIONS is an alist of properties and their new values.
  1283. The server must support modifying annotations for this to work."
  1284. (pdf-info-assert-writable-annotations)
  1285. (let ((edits
  1286. (mapcar
  1287. (lambda (elt)
  1288. (cl-case (car elt)
  1289. (color
  1290. (list (car elt)
  1291. (pdf-util-hexcolor (cdr elt))))
  1292. (edges
  1293. (list (car elt)
  1294. (mapconcat 'number-to-string (cdr elt) " ")))
  1295. ((popup-is-open is-open)
  1296. (list (car elt) (if (cdr elt) 1 0)))
  1297. (t
  1298. (list (car elt) (cdr elt)))))
  1299. modifications)))
  1300. (apply 'pdf-info-query
  1301. 'editannot
  1302. (pdf-info--normalize-file-or-buffer file-or-buffer)
  1303. id
  1304. (apply 'append edits))))
  1305. (defun pdf-info-save (&optional file-or-buffer)
  1306. "Save FILE-OR-BUFFER.
  1307. This saves the document to a new temporary file, which is
  1308. returned and owned by the caller."
  1309. (pdf-info-assert-writable-annotations)
  1310. (pdf-info-query
  1311. 'save
  1312. (pdf-info--normalize-file-or-buffer file-or-buffer)))
  1313. (defun pdf-info-getattachment-from-annot (id &optional do-save file-or-buffer)
  1314. "Return the attachment associated with annotation ID.
  1315. ID should be a symbol which was previously returned in a
  1316. `pdf-info-getannots' query, and referencing an attachment of type
  1317. `file', otherwise an error is signaled.
  1318. See `pdf-info-getattachments' for the kind of return value of this
  1319. function and the meaning of DO-SAVE."
  1320. (pdf-info-query
  1321. 'getattachment-from-annot
  1322. (pdf-info--normalize-file-or-buffer file-or-buffer)
  1323. id
  1324. (if do-save 1 0)))
  1325. (defun pdf-info-getattachments (&optional do-save file-or-buffer)
  1326. "Return all document level attachments.
  1327. If DO-SAVE is non-nil, save the attachments data to a local file,
  1328. which is then owned by the caller, see below.
  1329. This function returns a list of alists, where every element
  1330. contains the following keys. All values, except for id, may be
  1331. nil, i.e. not present.
  1332. id - A symbol uniquely identifying this attachment.
  1333. filename - The filename of this attachment.
  1334. description - A description of this attachment.
  1335. size - The size in bytes.
  1336. modified - The last modification date.
  1337. created - The date of creation.
  1338. checksum - A MD5 checksum of this attachment's data.
  1339. file - The name of a tempfile containing the data (only present if
  1340. DO-SAVE is non-nil)."
  1341. (pdf-info-query
  1342. 'getattachments
  1343. (pdf-info--normalize-file-or-buffer file-or-buffer)
  1344. (if do-save 1 0)))
  1345. (defun pdf-info-synctex-forward-search (source &optional line column file-or-buffer)
  1346. "Perform a forward search with synctex.
  1347. SOURCE should be a LaTeX buffer or the absolute filename of a
  1348. corresponding file. LINE and COLUMN represent the position in
  1349. the buffer or file. Finally FILE-OR-BUFFER corresponds to the
  1350. PDF document.
  1351. Returns an alist with entries PAGE and relative EDGES describing
  1352. the position in the PDF document corresponding to the SOURCE
  1353. location."
  1354. (let ((source (if (buffer-live-p (get-buffer source))
  1355. (buffer-file-name (get-buffer source))
  1356. source)))
  1357. (pdf-info-query
  1358. 'synctex-forward-search
  1359. (pdf-info--normalize-file-or-buffer file-or-buffer)
  1360. source
  1361. (or line 1)
  1362. (or column 1))))
  1363. (defun pdf-info-synctex-backward-search (page &optional x y file-or-buffer)
  1364. "Perform a backward search with synctex.
  1365. Find the source location corresponding to the coordinates
  1366. \(X . Y\) on PAGE in FILE-OR-BUFFER.
  1367. Returns an alist with entries FILENAME, LINE and COLUMN."
  1368. (pdf-info-query
  1369. 'synctex-backward-search
  1370. (pdf-info--normalize-file-or-buffer file-or-buffer)
  1371. page
  1372. (or x 0)
  1373. (or y 0)))
  1374. (defun pdf-info-renderpage (page width &optional file-or-buffer &rest commands)
  1375. "Render PAGE with width WIDTH.
  1376. Return the data of the corresponding PNG image."
  1377. (when (keywordp file-or-buffer)
  1378. (push file-or-buffer commands)
  1379. (setq file-or-buffer nil))
  1380. (apply 'pdf-info-query
  1381. 'renderpage
  1382. (pdf-info--normalize-file-or-buffer file-or-buffer)
  1383. page
  1384. (* width (pdf-util-frame-scale-factor))
  1385. (let (transformed)
  1386. (while (cdr commands)
  1387. (let ((kw (pop commands))
  1388. (value (pop commands)))
  1389. (setq value
  1390. (cl-case kw
  1391. ((:crop-to :highlight-line :highlight-region :highlight-text)
  1392. (mapconcat 'number-to-string value " "))
  1393. ((:foreground :background)
  1394. (pdf-util-hexcolor value))
  1395. (:alpha
  1396. (number-to-string value))
  1397. (otherwise value)))
  1398. (push kw transformed)
  1399. (push value transformed)))
  1400. (when commands
  1401. (error "Keyword is missing a value: %s" (car commands)))
  1402. (nreverse transformed))))
  1403. (defun pdf-info-renderpage-text-regions (page width single-line-p
  1404. &optional file-or-buffer
  1405. &rest regions)
  1406. "Highlight text on PAGE with width WIDTH using REGIONS.
  1407. REGIONS is a list determining foreground and background color and
  1408. the regions to render. So each element should look like \(FG BG
  1409. \(LEFT TOP RIGHT BOT\) \(LEFT TOP RIGHT BOT\) ... \) . The
  1410. rendering is text-aware.
  1411. If SINGLE-LINE-P is non-nil, the edges in REGIONS are each
  1412. supposed to be limited to a single line in the document. Setting
  1413. this, if applicable, avoids rendering problems.
  1414. For the other args see `pdf-info-renderpage'.
  1415. Return the data of the corresponding PNG image."
  1416. (when (consp file-or-buffer)
  1417. (push file-or-buffer regions)
  1418. (setq file-or-buffer nil))
  1419. (apply 'pdf-info-renderpage
  1420. page width file-or-buffer
  1421. (apply 'append
  1422. (mapcar (lambda (elt)
  1423. `(:foreground ,(pop elt)
  1424. :background ,(pop elt)
  1425. ,@(cl-mapcan (lambda (edges)
  1426. `(,(if single-line-p
  1427. :highlight-line
  1428. :highlight-text)
  1429. ,edges))
  1430. elt)))
  1431. regions))))
  1432. (defun pdf-info-renderpage-highlight (page width
  1433. &optional file-or-buffer
  1434. &rest regions)
  1435. "Highlight regions on PAGE with width WIDTH using REGIONS.
  1436. REGIONS is a list determining the background color, a alpha value
  1437. and the regions to render. So each element should look like \(FILL-COLOR
  1438. STROKE-COLOR ALPHA \(LEFT TOP RIGHT BOT\) \(LEFT TOP RIGHT BOT\) ... \)
  1439. .
  1440. For the other args see `pdf-info-renderpage'.
  1441. Return the data of the corresponding PNG image."
  1442. (when (consp file-or-buffer)
  1443. (push file-or-buffer regions)
  1444. (setq file-or-buffer nil))
  1445. (apply 'pdf-info-renderpage
  1446. page width file-or-buffer
  1447. (apply 'append
  1448. (mapcar (lambda (elt)
  1449. `(:background ,(pop elt)
  1450. :foreground ,(pop elt)
  1451. :alpha ,(pop elt)
  1452. ,@(cl-mapcan (lambda (edges)
  1453. `(:highlight-region ,edges))
  1454. elt)))
  1455. regions))))
  1456. (defun pdf-info-boundingbox (page &optional file-or-buffer)
  1457. "Return a bounding-box for PAGE.
  1458. Returns a list \(LEFT TOP RIGHT BOT\)."
  1459. (pdf-info-query
  1460. 'boundingbox
  1461. (pdf-info--normalize-file-or-buffer file-or-buffer)
  1462. page))
  1463. (defun pdf-info-getoptions (&optional file-or-buffer)
  1464. (pdf-info-query
  1465. 'getoptions
  1466. (pdf-info--normalize-file-or-buffer file-or-buffer)))
  1467. (defun pdf-info-setoptions (&optional file-or-buffer &rest options)
  1468. (when (symbolp file-or-buffer)
  1469. (push file-or-buffer options)
  1470. (setq file-or-buffer nil))
  1471. (unless (= (% (length options) 2) 0)
  1472. (error "Missing a option value"))
  1473. (apply 'pdf-info-query
  1474. 'setoptions
  1475. (pdf-info--normalize-file-or-buffer file-or-buffer)
  1476. (let (soptions)
  1477. (while options
  1478. (let ((key (pop options))
  1479. (value (pop options)))
  1480. (unless (and (keywordp key)
  1481. (not (eq key :)))
  1482. (error "Keyword expected: %s" key))
  1483. (cl-case key
  1484. ((:render/foreground :render/background)
  1485. (push (pdf-util-hexcolor value)
  1486. soptions))
  1487. ((:render/usecolors :render/printed)
  1488. (push (if value 1 0) soptions))
  1489. (t (push value soptions)))
  1490. (push key soptions)))
  1491. soptions)))
  1492. (defun pdf-info-pagelabels (&optional file-or-buffer)
  1493. "Return a list of pagelabels.
  1494. Returns a list of strings corresponding to the labels of the
  1495. pages in FILE-OR-BUFFER."
  1496. (pdf-info-query
  1497. 'pagelabels
  1498. (pdf-info--normalize-file-or-buffer file-or-buffer)))
  1499. (defun pdf-info-ping (&optional message)
  1500. "Ping the server using MESSAGE.
  1501. Returns MESSAGE, which defaults to \"pong\"."
  1502. (pdf-info-query 'ping (or message "pong")))
  1503. (provide 'pdf-info)
  1504. ;;; pdf-info.el ends here