dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

pdf-info.el (63708B)


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