kemonine/emacs
Archived
1
0
Fork 0
Code Activity
This repository has been archived on 2024-10-19. You can view files and clone it, but cannot push or open issues or pull requests.
emacs/org/elpa/pdf-tools-20240429.407/pdf-info.el

1770 lines
64 KiB
EmacsLisp
Raw Permalink Normal View History

update [m]elpa
2023-02-21 18:17:08 +00:00
;;; pdf-info.el --- Extract info from pdf-files via a helper process. -*- lexical-binding: t -*-
;; Copyright (C) 2013, 2014 Andreas Politz
;; Author: Andreas Politz <politza@fh-trier.de>
;; Keywords: files, multimedia
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; This library represents the Lisp side of the epdfinfo server. This
;; program works on a command/response basis, but there should be no
;; need to understand the protocol, since every command has a
;; corresponding Lisp-function (see below under `High level
;; interface').
;;
;; Most of these functions receive a file-or-buffer argument, which
;; may be what it says and defaults to the current buffer. Also, most
;; functions return some sort of alist, with, in most cases,
;; straight-forward key-value-pairs. Though some may be only
;; understandable in the context of Adobe's PDF spec \(Adobe
;; PDF32000\) or the poppler documentation (e.g. annotation flags).
;;
;; If the poppler library is fairly recent (>= 0.19.4, older versions
;; have a bug, which may corrupt the document), annotations maybe
;; modified to a certain degree, deleted and text-annotations created.
;; The state of these modifications is held in the server. In order
;; to realize, annotations retrieved or created are referenced by a
;; unique symbol. Saving these changes creates a new file, the
;; original document is never touched.
;;; Todo:
;;
;; + Close documents at some time (e.g. when the buffer is killed)
;;
;;; Code:
(require 'tq)
(require 'cl-lib)
;; * ================================================================== *
;; * Customizations
;; * ================================================================== *
(defgroup pdf-info nil
"Extract infos from pdf-files via a helper process."
:group 'pdf-tools)
(defcustom pdf-info-epdfinfo-program
(let ((executable (if (eq system-type 'windows-nt)
"epdfinfo.exe" "epdfinfo"))
(default-directory
(or (and load-file-name
(file-name-directory load-file-name))
default-directory)))
(cl-labels ((try-directory (directory)
(and (file-directory-p directory)
(file-executable-p (expand-file-name executable directory))
(expand-file-name executable directory))))
(or (executable-find executable)
;; This works if epdfinfo is in the same place as emacs and
;; the editor was started with an absolute path, i.e. it is
;; meant for Windows/Msys2.
(and (stringp (car-safe command-line-args))
(file-name-directory (car command-line-args))
(try-directory
(file-name-directory (car command-line-args))))
;; If we are running directly from the git repo.
(try-directory (expand-file-name "../server"))
;; Fall back to epdfinfo in the directory of this file.
(expand-file-name executable))))
"Filename of the epdfinfo executable."
:type 'file)
(defcustom pdf-info-epdfinfo-error-filename nil
"Filename for error output of the epdfinfo executable.
If nil, discard any error messages. Useful for debugging."
:type `(choice (const :tag "None" nil)
,@(when (file-directory-p "/tmp/")
'((const "/tmp/epdfinfo.log")))
(file)))
(defcustom pdf-info-log nil
"Whether to log the communication with the server.
If this is non-nil, all communication with the epdfinfo program
will be logged to the buffer \"*pdf-info-log*\"."
:type 'boolean)
(defcustom pdf-info-log-entry-max 512
"Maximum number of characters in a single log entry.
This variable has no effect if `pdf-info-log' is nil."
:type 'integer)
(defcustom pdf-info-restart-process-p 'ask
"What to do when the epdfinfo server died.
This should be one of
nil -- do nothing,
t -- automatically restart it or
ask -- ask whether to restart or not.
If it is `ask', the server quits and you answer no, this variable
is set to nil."
:type '(choice (const :tag "Do nothing" nil)
(const :tag "Restart silently" t)
(const :tag "Always ask" ask)))
(defcustom pdf-info-close-document-hook nil
"A hook ran after a document was closed in the server.
The hook is run in the documents buffer, if it exists. Otherwise
in a `with-temp-buffer' form."
:type 'hook)
;; * ================================================================== *
;; * Variables
;; * ================================================================== *
(defvar pdf-info-asynchronous nil
"If non-nil process queries asynchronously.
More specifically the value should be a function of at 2
arguments \(fn STATUS RESPONSE\), where STATUS is either nil, for
a successful query, or the symbol error. RESPONSE is either the
command's response or the error message. This does not work
recursive, i.e. if function wants to make another asynchronous
query it has to rebind this variable.
Alternatively it may be a list \(FN . ARGS\), in which case FN
will be invoked like \(apply FN STATUS RESPONSE ARGS\).
Also, all pdf-info functions normally returning a response return
nil.
This variable should only be let-bound.")
(defconst pdf-info-pdf-date-regexp
;; Adobe PDF32000.book, 7.9.4 Dates
(eval-when-compile
(concat
;; allow for preceding garbage
;;"\\`"
"[dD]:"
"\\([0-9]\\{4\\}\\)" ;year
"\\(?:"
"\\([0-9]\\{2\\}\\)" ;month
"\\(?:"
"\\([0-9]\\{2\\}\\)" ;day
"\\(?:"
"\\([0-9]\\{2\\}\\)" ;hour
"\\(?:"
"\\([0-9]\\{2\\}\\)" ;minutes
"\\(?:"
"\\([0-9]\\{2\\}\\)" ;seconds
"\\)?\\)?\\)?\\)?\\)?"
"\\(?:"
"\\([+-Zz]\\)" ;UT delta char
"\\(?:"
"\\([0-9]\\{2\\}\\)" ;UT delta hours
"\\(?:"
"'"
"\\([0-9]\\{2\\}\\)" ;UT delta minutes
"\\)?\\)?\\)?"
;; "\\'"
;; allow for trailing garbage
)))
(defvar pdf-info--queue t
"Internally used transmission-queue for the server.
This variable is initially t, telling the code starting the
server, that it never ran.")
;; * ================================================================== *
;; * Process handling
;; * ================================================================== *
(defconst pdf-info-empty-page-data
(eval-when-compile
(concat
"%PDF-1.0\n1 0 obj<</Type/Catalog/Pages 2 0 R>>endobj 2 0"
" obj<</Type/Pages/Kids[3 0 R]/Count 1>>endobj 3 0 obj<</"
"Type/Page/MediaBox[0 0 3 3]>>endobj\nxref\n0 4\n00000000"
"0065535 f\n0000000010 00000 n\n0000000053 00000 n\n00000"
"00102 00000 n\ntrailer<</Size 4/Root 1 0 R>>\nstartxref\n149\n%EOF"))
"PDF data of an empty page.")
(defun pdf-info-process ()
"Return the process object or nil."
(and pdf-info--queue
(not (eq t pdf-info--queue))
(tq-process pdf-info--queue)))
(defun pdf-info-check-epdfinfo (&optional interactive-p)
"Check if the server should be working properly.
Signal an error if some problem was found. Message a
confirmation, if INTERACTIVE-P is non-nil and no problems were
found.
Returns nil."
(interactive "p")
(let ((executable pdf-info-epdfinfo-program))
(unless (stringp executable)
(error "pdf-info-epdfinfo-program is unset or not a string"))
(unless (file-executable-p executable)
(error "pdf-info-epdfinfo-program is not executable"))
(when pdf-info-epdfinfo-error-filename
(unless (and (stringp pdf-info-epdfinfo-error-filename)
(file-writable-p pdf-info-epdfinfo-error-filename))
(error "pdf-info-epdfinfo-error-filename should contain writable filename")))
(let* ((default-directory (expand-file-name "~/"))
(cmdfile (make-temp-file "commands"))
(pdffile (make-temp-file "empty.pdf"))
(tempdir (make-temp-file "tmpdir" t))
(process-environment (cons (concat "TMPDIR=" tempdir)
process-environment)))
(unwind-protect
(with-temp-buffer
(with-temp-file pdffile
(set-buffer-multibyte nil)
(insert pdf-info-empty-page-data))
(with-temp-file cmdfile
(insert (format "renderpage:%s:1:100\nquit\n"
(pdf-info-query--escape pdffile))))
(unless (= 0 (apply #'call-process
executable cmdfile (current-buffer)
nil (when pdf-info-epdfinfo-error-filename
(list pdf-info-epdfinfo-error-filename))))
(error "Error running `%s': %s"
pdf-info-epdfinfo-program
(buffer-string))))
(when (file-exists-p cmdfile)
(delete-file cmdfile))
(when (file-exists-p pdffile)
(delete-file pdffile))
(when (file-exists-p tempdir)
(delete-directory tempdir t)))))
(when interactive-p
(message "The epdfinfo program appears to be working."))
nil)
(defun pdf-info-process-assert-running (&optional force)
"Assert a running process.
If it never ran, i.e. `pdf-info-process' is t, start it
unconditionally.
Otherwise, if FORCE is non-nil start it, if it is not running.
Else restart it with respect to the variable
`pdf-info-restart-process-p', which see.
If getting the process to run fails, this function throws an
error."
(interactive "P")
(unless (and (processp (pdf-info-process))
(eq (process-status (pdf-info-process))
'run))
(when (pdf-info-process)
(tq-close pdf-info--queue)
(setq pdf-info--queue nil))
(unless (or force
(eq pdf-info--queue t)
(and (eq pdf-info-restart-process-p 'ask)
(not noninteractive)
(y-or-n-p "The epdfinfo server quit, restart it ? "))
(and pdf-info-restart-process-p
(not (eq pdf-info-restart-process-p 'ask))))
(when (eq pdf-info-restart-process-p 'ask)
(setq pdf-info-restart-process-p nil))
(error "The epdfinfo server quit"))
(pdf-info-check-epdfinfo)
(let* ((process-connection-type) ;Avoid 4096 Byte bug #12440.
(default-directory "~")
(proc (apply #'start-process
"epdfinfo" " *epdfinfo*" pdf-info-epdfinfo-program
(when pdf-info-epdfinfo-error-filename
(list pdf-info-epdfinfo-error-filename)))))
(with-current-buffer " *epdfinfo*"
(erase-buffer))
(set-process-query-on-exit-flag proc nil)
(set-process-coding-system proc 'utf-8-unix 'utf-8-unix)
(setq pdf-info--queue (tq-create proc))))
pdf-info--queue)
(when (< emacs-major-version 27)
(advice-add 'tq-process-buffer :around #'pdf-info--tq-workaround))
(defun pdf-info--tq-workaround (orig-fun tq &rest args)
"Fix a bug in trunk where the wrong callback gets called.
ORIG-FUN is the callback that should be called. TQ and ARGS are
the transmission-queue and arguments to the callback."
;; FIXME: Make me iterative.
(if (not (equal (car (process-command (tq-process tq)))
pdf-info-epdfinfo-program))
(apply orig-fun tq args)
(let ((buffer (tq-buffer tq))
done)
(when (buffer-live-p buffer)
(set-buffer buffer)
(while (and (not done)
(> (buffer-size) 0))
(setq done t)
(if (tq-queue-empty tq)
(let ((buf (generate-new-buffer "*spurious*")))
(copy-to-buffer buf (point-min) (point-max))
(delete-region (point-min) (point))
(pop-to-buffer buf nil)
(error "Spurious communication from process %s, see buffer %s"
(process-name (tq-process tq))
(buffer-name buf)))
(goto-char (point-min))
(when (re-search-forward (tq-queue-head-regexp tq) nil t)
(setq done nil)
(let ((answer (buffer-substring (point-min) (point)))
(fn (tq-queue-head-fn tq))
(closure (tq-queue-head-closure tq)))
(delete-region (point-min) (point))
(tq-queue-pop tq)
(condition-case-unless-debug err
(funcall fn closure answer)
(error
(message "Error while processing tq callback: %s"
(error-message-string err))))))))))))
;; * ================================================================== *
;; * Sending and receiving
;; * ================================================================== *
(defun pdf-info-query (cmd &rest args)
"Query the server using CMD and ARGS."
(pdf-info-process-assert-running)
(unless (symbolp cmd)
(setq cmd (intern cmd)))
(let* ((query (concat (mapconcat #'pdf-info-query--escape
(cons cmd args) ":")
"\n"))
(callback
(lambda (closure response)
(cl-destructuring-bind (status &rest result)
(pdf-info-query--parse-response cmd response)
(pdf-info-query--log response)
(let* (pdf-info-asynchronous)
(if (functionp closure)
(funcall closure status result)
(apply (car closure) status result (cdr closure)))))))
response status done
(closure (or pdf-info-asynchronous
(lambda (s r)
(setq status s response r done t)))))
(pdf-info-query--log query t)
(tq-enqueue
pdf-info--queue query "^\\.\n" closure callback)
(unless pdf-info-asynchronous
(while (and (not done)
(eq (process-status (pdf-info-process))
'run))
(accept-process-output (pdf-info-process) 0.01))
(when (and (not done)
(not (eq (process-status (pdf-info-process))
'run))
(not (eq cmd 'quit)))
(error "The epdfinfo server quit unexpectedly"))
(cond
((null status) response)
((eq status 'error)
(error "epdfinfo: %s" response))
((eq status 'interrupted)
(error "epdfinfo: Command was interrupted"))
(t
(error "Internal error: invalid response status"))))))
(defun pdf-info-interrupt ()
"FIXME: This command does currently nothing."
(when (and (processp (pdf-info-process))
(eq (process-status (pdf-info-process))
'run))
(signal-process (pdf-info-process) 'SIGUSR1)))
(defun pdf-info-query--escape (arg)
"Escape ARG for transmission to the server."
(if (null arg)
(string)
(with-current-buffer (get-buffer-create " *pdf-info-query--escape*")
(erase-buffer)
(insert (format "%s" arg))
(goto-char 1)
(while (not (eobp))
(cond
((memq (char-after) '(?\\ ?:))
(insert ?\\))
((eq (char-after) ?\n)
(delete-char 1)
(insert ?\\ ?n)
(backward-char)))
(forward-char))
(buffer-substring-no-properties 1 (point-max)))))
(defmacro pdf-info-query--read-record ()
"Read a single record of the response in current buffer."
`(let (records done (beg (point)))
(while (not done)
(cl-case (char-after)
(?\\
(delete-char 1)
(if (not (eq (char-after) ?n))
(forward-char)
(delete-char 1)
(insert ?\n)))
((?: ?\n)
(push (buffer-substring-no-properties
beg (point)) records)
(forward-char)
(setq beg (point)
done (bolp)))
(t (forward-char))))
(nreverse records)))
(defun pdf-info-query--parse-response (cmd response)
"Parse one epdfinfo RESPONSE to CMD.
Returns a cons \(STATUS . RESULT\), where STATUS is one of nil
for a regular response, error for an error \(RESULT contains the
error message\) or interrupted, i.e. the command was
interrupted."
(with-current-buffer
(get-buffer-create " *pdf-info-query--parse-response*")
(erase-buffer)
(insert response)
(goto-char 1)
(cond
((looking-at "ERR\n")
(forward-line)
(cons 'error (buffer-substring-no-properties
(point)
(progn
(re-search-forward "^\\.\n")
(1- (match-beginning 0))))))
((looking-at "OK\n")
(let (result)
(forward-line)
(while (not (and (= (char-after) ?.)
(= (char-after (1+ (point))) ?\n)))
(push (pdf-info-query--read-record) result))
(cons nil (pdf-info-query--transform-response
cmd (nreverse result)))))
((looking-at "INT\n")
(cons 'interrupted nil))
(t
(cons 'error "Invalid server response")))))
(defun pdf-info-query--transform-response (cmd response)
"Transform a RESPONSE to CMD into a Lisp form."
(cl-case cmd
(open nil)
(close (equal "1" (caar response)))
(number-of-pages (string-to-number (caar response)))
(charlayout
(mapcar (lambda (elt)
(cl-assert (= 1 (length (cadr elt))) t)
`(,(aref (cadr elt) 0)
,(mapcar #'string-to-number
(split-string (car elt) " " t))))
response))
(regexp-flags
(mapcar (lambda (elt)
(cons (intern (car elt))
(string-to-number (cadr elt))))
response))
((search-string search-regexp)
(mapcar
(lambda (r)
`((page . ,(string-to-number (nth 0 r)))
(text . ,(let (case-fold-search)
(pdf-util-highlight-regexp-in-string
(regexp-quote (nth 1 r)) (nth 2 r))))
(edges . ,(mapcar (lambda (m)
(mapcar #'string-to-number
(split-string m " " t)))
(cddr (cdr r))))))
response))
(outline
(mapcar (lambda (r)
`((depth . ,(string-to-number (pop r)))
,@(pdf-info-query--transform-action r)))
response))
(pagelinks
(mapcar (lambda (r)
`((edges .
,(mapcar #'string-to-number ;area
(split-string (pop r) " " t)))
,@(pdf-info-query--transform-action r)))
response))
(metadata
(let ((md (car response)))
(if (= 1 (length md))
(list (cons 'title (car md)))
(list
(cons 'title (pop md))
(cons 'author (pop md))
(cons 'subject (pop md))
(cons 'keywords-raw (car md))
(cons 'keywords (split-string (pop md) "[\t\n ]*,[\t\n ]*" t))
(cons 'creator (pop md))
(cons 'producer (pop md))
(cons 'format (pop md))
(cons 'created (pop md))
(cons 'modified (pop md))))))
(gettext
(or (caar response) ""))
(getselection
(mapcar (lambda (line)
(mapcar #'string-to-number
(split-string (car line) " " t)))
response))
(features (mapcar #'intern (car response)))
(pagesize
(setq response (car response))
(cons (round (string-to-number (car response)))
(round (string-to-number (cadr response)))))
((getannot editannot addannot)
(pdf-info-query--transform-annotation (car response)))
(getannots
(mapcar #'pdf-info-query--transform-annotation response))
(getattachments
(mapcar #'pdf-info-query--transform-attachment response))
((getattachment-from-annot)
(pdf-info-query--transform-attachment (car response)))
(boundingbox
(mapcar #'string-to-number (car response)))
(synctex-forward-search
(let ((list (mapcar #'string-to-number (car response))))
`((page . ,(car list))
(edges . ,(cdr list)))))
(synctex-backward-search
`((filename . ,(caar response))
(line . ,(string-to-number (cadr (car response))))
(column . ,(string-to-number (cadr (cdar response))))))
(delannot nil)
((save) (caar response))
((renderpage renderpage-text-regions renderpage-highlight)
(pdf-util-munch-file (caar response)))
((setoptions getoptions)
(let (options)
(dolist (key-value response)
(let ((key (intern (car key-value)))
(value (cadr key-value)))
(cl-case key
((:render/printed)
(setq value (equal value "1")))
((:render/usecolors)
(setq value (ignore-errors
(let ((int-val (cl-parse-integer value)))
(if (> 3 int-val 0)
int-val
0))))))
(push value options)
(push key options)))
options))
(pagelabels (mapcar #'car response))
(ping (caar response))
(t response)))
(defun pdf-info-query--transform-action (action)
"Transform ACTION response into a Lisp form."
(let ((type (intern (pop action))))
`((type . ,type)
(title . ,(pop action))
,@(cl-case type
(goto-dest
`((page . ,(string-to-number (pop action)))
(top . ,(and (> (length (car action)) 0)
(string-to-number (pop action))))))
(goto-remote
`((filename . ,(pop action))
(page . ,(string-to-number (pop action)))
(top . ,(and (> (length (car action)) 0)
(string-to-number (pop action))))))
(t `((uri . ,(pop action))))))))
(defun pdf-info-query--transform-annotation (a)
(cl-labels ((not-empty (s)
(if (not (equal s "")) s)))
(let (a1 a2 a3)
(cl-destructuring-bind (page edges type id flags color contents modified &rest rest)
a
(setq a1 `((page . ,(string-to-number page))
(edges . ,(mapcar #'string-to-number
(split-string edges " " t)))
(type . ,(intern type))
(id . ,(intern id))
(flags . ,(string-to-number flags))
(color . ,(not-empty color))
(contents . ,contents)
(modified . ,(pdf-info-parse-pdf-date modified))))
(when rest
(cl-destructuring-bind (label subject opacity popup-edges popup-is-open created
&rest rest)
rest
(setq a2
`((label . ,(not-empty label))
(subject . ,(not-empty subject))
(opacity . ,(let ((o (not-empty opacity)))
(and o (string-to-number o))))
(popup-edges . ,(let ((p (not-empty popup-edges)))
(when p
(mapcar #'string-to-number
(split-string p " " t)))))
(popup-is-open . ,(equal popup-is-open "1"))
(created . ,(pdf-info-parse-pdf-date (not-empty created)))))
(cond
((eq (cdr (assoc 'type a1)) 'text)
(cl-destructuring-bind (icon state is-open)
rest
(setq a3
`((icon . ,(not-empty icon))
(state . ,(not-empty state))
(is-open . ,(equal is-open "1"))))))
((memq (cdr (assoc 'type a1))
'(squiggly highlight underline strike-out))
(setq a3 `((markup-edges
. ,(mapcar (lambda (r)
(mapcar #'string-to-number
(split-string r " " t)))
rest)))))))))
(append a1 a2 a3))))
(defun pdf-info-query--transform-attachment (a)
(cl-labels ((not-empty (s)
(if (not (equal s "")) s)))
(cl-destructuring-bind (id filename description size modified
created checksum file)
a
`((id . ,(intern id))
(filename . ,(not-empty filename))
(description . ,(not-empty description))
(size . ,(let ((n (string-to-number size)))
(and (>= n 0) n)))
(modified . ,(not-empty modified))
(created . ,(not-empty created))
(checksum . ,(not-empty checksum))
(file . ,(not-empty file))))))
(defun pdf-info-query--log (string &optional query-p)
"Log STRING as query/response, depending on QUERY-P.
This is a no-op, if `pdf-info-log' is nil."
(when pdf-info-log
(with-current-buffer (get-buffer-create "*pdf-info-log*")
(buffer-disable-undo)
(let ((pos (point-max))
(window (get-buffer-window)))
(save-excursion
(goto-char (point-max))
(unless (bolp)
(insert ?\n))
(insert
(propertize
(format-time-string "%H:%M:%S ")
'face
(if query-p
'font-lock-keyword-face
'font-lock-function-name-face))
(if (and (numberp pdf-info-log-entry-max)
(> (length string)
pdf-info-log-entry-max))
(concat (substring string 0 pdf-info-log-entry-max)
"...[truncated]\n")
string)))
(when (and (window-live-p window)
(= pos (window-point window)))
(set-window-point window (point-max)))))))
;; * ================================================================== *
;; * Utility functions
;; * ================================================================== *
(defvar doc-view-buffer-file-name)
(defvar doc-view--buffer-file-name)
(defun pdf-info--normalize-file-or-buffer (file-or-buffer)
"Return the PDF file corresponding to FILE-OR-BUFFER.
FILE-OR-BUFFER may be nil, a PDF buffer, the name of a PDF buffer
or a PDF file."
(unless file-or-buffer
(setq file-or-buffer
(current-buffer)))
(when (bufferp file-or-buffer)
(unless (buffer-live-p file-or-buffer)
(error "Buffer is not live :%s" file-or-buffer))
(with-current-buffer file-or-buffer
(unless (setq file-or-buffer
(cl-case major-mode
(doc-view-mode
(cond ((boundp 'doc-view-buffer-file-name)
doc-view-buffer-file-name)
((boundp 'doc-view--buffer-file-name)
doc-view--buffer-file-name)))
(pdf-view-mode (pdf-view-buffer-file-name))
(t (buffer-file-name))))
(error "Buffer is not associated with any file :%s" (buffer-name)))))
(unless (stringp file-or-buffer)
(signal 'wrong-type-argument
(list 'stringp 'bufferp 'null file-or-buffer)))
;; is file
(when (file-remote-p file-or-buffer)
(error "Processing remote files not supported :%s"
file-or-buffer))
;; (unless (file-readable-p file-or-buffer)
;; (error "File not readable :%s" file-or-buffer))
(expand-file-name file-or-buffer))
(defun pdf-info-valid-page-spec-p (pages)
"The type predicate for a valid page-spec."
(not (not (ignore-errors (pdf-info-normalize-page-range pages)))))
(defun pdf-info-normalize-page-range (pages)
"Normalize PAGES for sending to the server.
PAGES may be a single page number, a cons \(FIRST . LAST\), or
nil, which stands for all pages.
The result is a cons \(FIRST . LAST\), where LAST may be 0
representing the final page."
(cond
((natnump pages)
(cons pages pages))
((null pages)
(cons 1 0))
((and (natnump (car pages))
(natnump (cdr pages)))
pages)
(t
(signal 'wrong-type-argument
(list 'pdf-info-valid-page-spec-p pages)))))
(defun pdf-info-parse-pdf-date (date)
(when (and date
(string-match pdf-info-pdf-date-regexp date))
(let ((year (match-string 1 date))
(month (match-string 2 date))
(day (match-string 3 date))
(hour (match-string 4 date))
(min (match-string 5 date))
(sec (match-string 6 date))
(ut-char (match-string 7 date))
(ut-hour (match-string 8 date))
(ut-min (match-string 9 date))
(tz 0))
(when (or (equal ut-char "+")
(equal ut-char "-"))
(when ut-hour
(setq tz (* 3600 (string-to-number ut-hour))))
(when ut-min
(setq tz (+ tz (* 60 (string-to-number ut-min)))))
(when (equal ut-char "-")
(setq tz (- tz))))
(encode-time
(if sec (string-to-number sec) 0)
(if min (string-to-number min) 0)
(if hour (string-to-number hour) 0)
(if day (string-to-number day) 1)
(if month (string-to-number month) 1)
(string-to-number year)
tz))))
(defmacro pdf-info-compose-queries (let-forms &rest body)
"Let-bind each VAR to QUERIES results and evaluate BODY.
All queries in each QUERIES form are run by the server in the
order they appear and the results collected in a list, which is
bound to VAR. Then BODY is evaluated and its value becomes the
final result of all queries, unless at least one of them provoked
an error. In this case BODY is ignored and the error is the
result.
This macro handles synchronous and asynchronous calls,
i.e. `pdf-info-asynchronous' is non-nil, transparently.
\(FN \(\(VAR QUERIES\)...\) BODY\)"
(declare (indent 1)
(debug ((&rest &or
(symbolp &optional form)
symbolp)
body)))
(unless (cl-every (lambda (form)
(when (symbolp form)
(setq form (list form)))
(and (consp form)
(symbolp (car form))
(listp (cdr form))))
let-forms)
(error "Invalid let-form: %s" let-forms))
(setq let-forms (mapcar (lambda (form)
(if (symbolp form)
(list form)
form))
let-forms))
(let* ((status (make-symbol "status"))
(response (make-symbol "response"))
(first-error (make-symbol "first-error"))
(done (make-symbol "done"))
(callback (make-symbol "callback"))
(results (make-symbol "results"))
(push-fn (make-symbol "push-fn"))
(terminal-fn (make-symbol "terminal-fn"))
(buffer (make-symbol "buffer")))
`(let* (,status
,response ,first-error ,done
(,buffer (current-buffer))
(,callback pdf-info-asynchronous)
;; Ensure a new alist on every invocation.
(,results (mapcar 'copy-sequence
',(cl-mapcar (lambda (form)
(list (car form)))
let-forms)))
(,push-fn (lambda (status result var)
;; Store result in alist RESULTS under key
;; VAR.
(if status
(unless ,first-error
(setq ,first-error result))
(let ((elt (assq var ,results)))
(setcdr elt (append (cdr elt)
(list result)))))))
(,terminal-fn
(lambda (&rest _)
;; Let-bind responses corresponding to their variables,
;; i.e. keys in alist RESULTS.
(let (,@(mapcar (lambda (var)
`(,var (cdr (assq ',var ,results))))
(mapcar #'car let-forms)))
(setq ,status (not (not ,first-error))
,response (or ,first-error
(with-current-buffer ,buffer
,@body))
,done t)
;; Maybe invoke the CALLBACK (which was bound to
;; pdf-info-asynchronous).
(when ,callback
(if (functionp ,callback)
(funcall ,callback ,status ,response)
(apply (car ,callback)
,status ,response (cdr ,callback))))))))
;; Wrap each query in an asynchronous call, with its VAR as
;; callback argument, so the PUSH-FN can put it in the alist
;; RESULTS.
,@(mapcar (lambda (form)
(list 'let (list
(list 'pdf-info-asynchronous
(list 'list push-fn (list 'quote (car form)))))
(cadr form)))
let-forms)
;; Request a no-op, just so we know that we are finished.
(let ((pdf-info-asynchronous ,terminal-fn))
(pdf-info-ping))
;; CALLBACK is the original value of pdf-info-asynchronous. If
;; nil, this is a synchronous query.
(unless ,callback
(while (and (not ,done)
(eq (process-status (pdf-info-process))
'run))
(accept-process-output (pdf-info-process) 0.01))
(when (and (not ,done)
(not (eq (process-status (pdf-info-process))
'run)))
(error "The epdfinfo server quit unexpectedly"))
(when ,status
(error "epdfinfo: %s" ,response))
,response))))
;; * ================================================================== *
;; * Buffer local server instances
;; * ================================================================== *
(put 'pdf-info--queue 'permanent-local t)
(defun pdf-info-make-local-server (&optional buffer force-restart-p)
"Create a server instance local to BUFFER.
Does nothing if BUFFER already has a local instance. Unless
FORCE-RESTART-P is non-nil, then quit a potential process and
restart it."
(unless buffer
(setq buffer (current-buffer)))
(with-current-buffer buffer
(unless (and
(not force-restart-p)
(local-variable-p 'pdf-info--queue)
(processp (pdf-info-process))
(eq (process-status (pdf-info-process))
'run))
(when (and (local-variable-p 'pdf-info--queue)
(processp (pdf-info-process)))
(tq-close pdf-info--queue))
(set (make-local-variable 'pdf-info--queue) nil)
(pdf-info-process-assert-running t)
(add-hook 'kill-buffer-hook #'pdf-info-kill-local-server nil t)
pdf-info--queue)))
(defun pdf-info-kill-local-server (&optional buffer)
"Kill the local server in BUFFER.
A No-op, if BUFFER has not running server instance."
(save-current-buffer
(when buffer
(set-buffer buffer))
(when (local-variable-p 'pdf-info--queue)
(pdf-info-kill)
(kill-local-variable 'pdf-info--queue)
t)))
(defun pdf-info-local-server-p (&optional buffer)
"Return non-nil, if BUFFER has a running server instance."
(unless buffer
(setq buffer (current-buffer)))
(setq buffer (get-buffer buffer))
(and (buffer-live-p buffer)
(local-variable-p 'pdf-info--queue buffer)))
(defun pdf-info-local-batch-query (producer-fn
consumer-fn
sentinel-fn
args)
"Process a set of queries asynchronously in a local instance."
(unless (pdf-info-local-server-p)
(error "Create a local server first"))
(let* ((buffer (current-buffer))
(producer-symbol (make-symbol "producer"))
(consumer-symbol (make-symbol "consumer"))
(producer
(lambda (args)
(if (null args)
(funcall sentinel-fn 'finished buffer)
(let ((pdf-info-asynchronous
(apply-partially
(symbol-function consumer-symbol)
args)))
(cond
((pdf-info-local-server-p buffer)
(with-current-buffer buffer
(apply producer-fn (car args))))
(t
(funcall sentinel-fn 'error buffer)))))))
(consumer (lambda (args status result)
(if (not (pdf-info-local-server-p buffer))
(funcall sentinel-fn 'error buffer)
(with-current-buffer buffer
(apply consumer-fn status result (car args)))
(funcall (symbol-function producer-symbol)
(cdr args))))))
(fset producer-symbol producer)
(fset consumer-symbol consumer)
(funcall producer args)))
;; * ================================================================== *
;; * High level interface
;; * ================================================================== *
(defvar pdf-info-features nil)
(defun pdf-info-features ()
"Return a list of symbols describing compile-time features."
(or pdf-info-features
(setq pdf-info-features
(let (pdf-info-asynchronous)
(pdf-info-query 'features)))))
(defun pdf-info-writable-annotations-p ()
(not (null (memq 'writable-annotations (pdf-info-features)))))
(defun pdf-info-markup-annotations-p ()
(not (null (memq 'markup-annotations (pdf-info-features)))))
(defmacro pdf-info-assert-writable-annotations ()
`(unless (memq 'writable-annotations (pdf-info-features))
(error "Writing annotations is not supported by this version of epdfinfo")))
(defmacro pdf-info-assert-markup-annotations ()
`(unless (memq 'markup-annotations (pdf-info-features))
(error "Creating markup annotations is not supported by this version of epdfinfo")))
(defun pdf-info-creatable-annotation-types ()
(let ((features (pdf-info-features)))
(cond
((not (memq 'writable-annotations features)) nil)
((memq 'markup-annotations features)
(list 'text 'squiggly 'underline 'strike-out 'highlight))
(t (list 'text)))))
(defun pdf-info-open (&optional file-or-buffer password)
"Open the document FILE-OR-BUFFER using PASSWORD.
Generally, documents are opened and closed automatically on
demand, so this function is rarely needed, unless a PASSWORD is
set on the document.
Manually opened documents are never closed automatically."
(pdf-info-query
'open (pdf-info--normalize-file-or-buffer file-or-buffer)
password))
(defun pdf-info-close (&optional file-or-buffer)
"Close the document FILE-OR-BUFFER.
Returns t, if the document was actually open, otherwise nil.
This command is rarely needed, see also `pdf-info-open'."
(let* ((pdf (pdf-info--normalize-file-or-buffer file-or-buffer))
(buffer (cond
((not file-or-buffer) (current-buffer))
((bufferp file-or-buffer) file-or-buffer)
((stringp file-or-buffer)
(find-buffer-visiting file-or-buffer)))))
(prog1
(pdf-info-query 'close pdf)
(if (buffer-live-p buffer)
(with-current-buffer buffer
(run-hooks 'pdf-info-close-document-hook))
(with-temp-buffer
(run-hooks 'pdf-info-close-document-hook))))))
(defun pdf-info-encrypted-p (&optional file-or-buffer)
"Return non-nil if FILE-OR-BUFFER requires a password.
Note: This function returns nil, if the document is encrypted,
but was already opened (presumably using a password)."
(condition-case err
(pdf-info-open
(pdf-info--normalize-file-or-buffer file-or-buffer))
(error (or (string-match-p
":Document is encrypted\\'" (cadr err))
(signal (car err) (cdr err))))))
(defun pdf-info-metadata (&optional file-or-buffer)
"Extract the metadata from the document FILE-OR-BUFFER.
This returns an alist containing some information about the
document."
(pdf-info-query
'metadata
(pdf-info--normalize-file-or-buffer file-or-buffer)))
(defun pdf-info-search-string (string &optional pages file-or-buffer)
"Search for STRING in PAGES of document FILE-OR-BUFFER.
See `pdf-info-normalize-page-range' for valid PAGES formats.
This function returns a list of matches. Each item is an alist
containing keys PAGE, TEXT and EDGES, where PAGE and TEXT are the
matched page resp. line. EDGES is a list containing a single
edges element \(LEFT TOP RIGHT BOTTOM\). This is for consistency
with `pdf-info-search-regexp', which may return matches with
multiple edges.
The TEXT contains `match' face properties on the matched parts.
Search is case-insensitive, unless `case-fold-search' is nil and
searching case-sensitive is supported by the server."
(let ((pages (pdf-info-normalize-page-range pages)))
(pdf-info-query
'search-string
(pdf-info--normalize-file-or-buffer file-or-buffer)
(car pages)
(cdr pages)
string
(if case-fold-search 1 0))))
(defvar pdf-info-regexp-compile-flags nil
"PCRE compile flags.
Don't use this, but the equally named function.")
(defvar pdf-info-regexp-match-flags nil
"PCRE match flags.
Don't use this, but the equally named function.")
(defun pdf-info-regexp-compile-flags ()
(or pdf-info-regexp-compile-flags
(let* (pdf-info-asynchronous
(flags (pdf-info-query 'regexp-flags))
(match (cl-remove-if-not
(lambda (flag)
(string-match-p
"\\`match-" (symbol-name (car flag))))
flags))
(compile (cl-set-difference flags match)))
(setq pdf-info-regexp-compile-flags compile
pdf-info-regexp-match-flags match)
pdf-info-regexp-compile-flags)))
(defun pdf-info-regexp-match-flags ()
(or pdf-info-regexp-match-flags
(progn
(pdf-info-regexp-compile-flags)
pdf-info-regexp-match-flags)))
(defvar pdf-info-regexp-flags '(multiline)
"Compile- and match-flags for the PCRE engine.
This is a list of symbols denoting compile- and match-flags when
searching for regular expressions.
You should not change this directly, but rather `let'-bind it
around a call to `pdf-info-search-regexp'.
Valid compile-flags are:
newline-crlf, newline-lf, newline-cr, dupnames, optimize,
no-auto-capture, raw, ungreedy, dollar-endonly, anchored,
extended, dotall, multiline and caseless.
Note that the last one, caseless, is handled special, as it is
always added if `case-fold-search' is non-nil.
And valid match-flags:
match-anchored, match-notbol, match-noteol, match-notempty,
match-partial, match-newline-cr, match-newline-lf,
match-newline-crlf and match-newline-any.
See the glib documentation at url
`https://developer.gnome.org/glib/stable/glib-Perl-compatible-regular-expressions.html'.")
(defun pdf-info-search-regexp (pcre &optional pages
no-error
file-or-buffer)
"Search for a PCRE on PAGES of document FILE-OR-BUFFER.
See `pdf-info-normalize-page-range' for valid PAGES formats and
`pdf-info-search-string' for its return value.
Uses the flags in `pdf-info-regexp-flags', which see. If
`case-fold-search' is non-nil, the caseless flag is added.
If NO-ERROR is non-nil, catch errors due to invalid regexps and
return nil. If it is the symbol `invalid-regexp', then re-signal
this kind of error as a `invalid-regexp' error."
(cl-labels ((orflags (flags alist)
(cl-reduce
(lambda (v flag)
(let ((n
(cdr (assq flag alist))))
(if n (logior n v) v)))
(cons 0 flags))))
(let ((pages (pdf-info-normalize-page-range pages)))
(condition-case err
(pdf-info-query
'search-regexp
(pdf-info--normalize-file-or-buffer file-or-buffer)
(car pages)
(cdr pages)
pcre
(orflags `(,(if case-fold-search
'caseless)
,@pdf-info-regexp-flags)
(pdf-info-regexp-compile-flags))
(orflags pdf-info-regexp-flags
(pdf-info-regexp-match-flags)))
(error
(let ((re
(concat "\\`epdfinfo: *Invalid *regexp: *"
;; glib error
"\\(?:Error while compiling regular expression"
" *%s *\\)?\\(.*\\)")))
(if (or (null no-error)
(not (string-match
(format re (regexp-quote pcre))
(cadr err))))
(signal (car err) (cdr err))
(if (eq no-error 'invalid-regexp)
(signal 'invalid-regexp
(list (match-string 1 (cadr err))))))))))))
(defun pdf-info-pagelinks (page &optional file-or-buffer)
"Return a list of links on PAGE in document FILE-OR-BUFFER.
This function returns a list of alists with the following keys.
EDGES represents the relative bounding-box of the link , TYPE is
the type of the action, TITLE is a, possibly empty, name for this
action.
TYPE may be one of
goto-dest -- This is a internal link to some page. Each element
contains additional keys PAGE and TOP, where PAGE is the page of
the link and TOP its vertical position.
goto-remote -- This a external link to some document. Same as
goto-dest, with an additional FILENAME of the external PDF.
uri -- A link in form of some URI. Alist contains additional key
URI.
In the first two cases, PAGE may be 0 and TOP nil, which means
these data is unspecified."
(cl-check-type page natnum)
(pdf-info-query
'pagelinks
(pdf-info--normalize-file-or-buffer file-or-buffer)
page))
(defun pdf-info-number-of-pages (&optional file-or-buffer)
"Return the number of pages in document FILE-OR-BUFFER."
(pdf-info-query 'number-of-pages
(pdf-info--normalize-file-or-buffer
file-or-buffer)))
(defun pdf-info-outline (&optional file-or-buffer)
"Return the PDF outline of document FILE-OR-BUFFER.
This function returns a list of alists like `pdf-info-pagelinks'.
Additionally every alist has a DEPTH (>= 1) entry with the depth
of this element in the tree."
(pdf-info-query
'outline
(pdf-info--normalize-file-or-buffer file-or-buffer)))
(defun pdf-info--selection-style (selection-style)
"SELECTION-STYLE is the smallest unit of the selected region.
It must be one of glyph, word or line. If it is none of these, we
fallback to glyph."
(cl-case selection-style
(glyph 0)
(word 1)
(line 2)
(t 0)))
(defun pdf-info-gettext (page edges &optional selection-style
file-or-buffer)
"Get text on PAGE according to EDGES.
EDGES should contain relative coordinates. The selection may
extend over multiple lines, which works similar to a Emacs
region. SELECTION-STYLE may be one of glyph, word or line and
determines the smallest unit of the selected region.
Return the text contained in the selection."
(pdf-info-query
'gettext
(pdf-info--normalize-file-or-buffer file-or-buffer)
page
(mapconcat #'number-to-string edges " ")
(pdf-info--selection-style selection-style)))
(defun pdf-info-getselection (page edges
&optional selection-style file-or-buffer)
"Return the edges of the selection EDGES on PAGE.
Arguments are the same as for `pdf-info-gettext'. Return a list
of edges corresponding to the text that would be returned by the
aforementioned function, when called with the same arguments."
(pdf-info-query
'getselection
(pdf-info--normalize-file-or-buffer file-or-buffer)
page
(mapconcat #'number-to-string edges " ")
(pdf-info--selection-style selection-style)))
(defun pdf-info-textregions (page &optional file-or-buffer)
"Return a list of edges describing PAGE's text-layout."
(pdf-info-getselection
page '(0 0 1 1) 'glyph file-or-buffer))
(defun pdf-info-charlayout (page &optional edges-or-pos file-or-buffer)
"Return the layout of characters of PAGE in/at EDGES-OR-POS.
Returns a list of elements \(CHAR . \(LEFT TOP RIGHT BOT\)\) mapping
character to their corresponding relative bounding-boxes.
EDGES-OR-POS may be a region \(LEFT TOP RIGHT BOT\) restricting
the returned value to include only characters fully contained in
it. Or a cons \(LEFT . TOP\) which means to only include the
character at this position. In this case the return value
contains at most one element."
;; FIXME: Actually returns \(CHAR . LEFT ...\).
(unless edges-or-pos
(setq edges-or-pos '(0 0 1 1)))
(when (numberp (cdr edges-or-pos))
(setq edges-or-pos (list (car edges-or-pos)
(cdr edges-or-pos)
-1 -1)))
(pdf-info-query
'charlayout
(pdf-info--normalize-file-or-buffer file-or-buffer)
page
(mapconcat #'number-to-string edges-or-pos " ")))
(defun pdf-info-pagesize (page &optional file-or-buffer)
"Return the size of PAGE as a cons \(WIDTH . HEIGHT\)
The size is in PDF points."
(pdf-info-query
'pagesize
(pdf-info--normalize-file-or-buffer file-or-buffer)
page))
(defun pdf-info-running-p ()
"Return non-nil, if the server is running."
(and (processp (pdf-info-process))
(eq (process-status (pdf-info-process))
'run)))
(defun pdf-info-quit (&optional timeout)
"Quit the epdfinfo server.
This blocks until all outstanding requests are answered. Unless
TIMEOUT is non-nil, in which case we wait at most TIMEOUT seconds
before killing the server."
(cl-check-type timeout (or null number))
(when (pdf-info-running-p)
(let ((pdf-info-asynchronous
(if timeout (lambda (&rest _))
pdf-info-asynchronous)))
(pdf-info-query 'quit)
(when timeout
(setq timeout (+ (float-time) (max 0 timeout)))
(while (and (pdf-info-running-p)
(> timeout (float-time)))
(accept-process-output (pdf-info-process) 0.5 nil t)))))
(when (processp (pdf-info-process))
(tq-close pdf-info--queue))
(setq pdf-info--queue nil))
(defun pdf-info-kill ()
"Kill the epdfinfo server.
Immediately delete the server process, see also `pdf-info-quit',
for a more sane way to exit the program."
(when (processp (pdf-info-process))
(tq-close pdf-info--queue))
(setq pdf-info--queue nil))
(defun pdf-info-getannots (&optional pages file-or-buffer)
"Return the annotations on PAGE.
See `pdf-info-normalize-page-range' for valid PAGES formats.
This function returns the annotations for PAGES as a list of
alists. Each element of this list describes one annotation and
contains the following keys.
page - Its page number.
edges - Its area.
type - A symbol describing the annotation's type.
id - A document-wide unique symbol referencing this annotation.
flags - Its flags, binary encoded.
color - Its color in standard Emacs notation.
contents - The text of this annotation.
modified - The last modification date of this annotation.
Additionally, if the annotation is a markup annotation, the
following keys are present.
label - The annotation's label.
subject - The subject addressed.
opacity - The level of relative opacity.
popup-edges - The edges of a associated popup window or nil.
popup-is-open - Whether this window should be displayed open.
created - The date this markup annotation was created.
If the annotation is also a markup text annotation, the alist
contains the following keys.
text-icon - A string describing the purpose of this annotation.
text-state - A string, e.g. accepted or rejected." ;FIXME: Use symbols ?
(let ((pages (pdf-info-normalize-page-range pages)))
(pdf-info-query
'getannots
(pdf-info--normalize-file-or-buffer file-or-buffer)
(car pages)
(cdr pages))))
(defun pdf-info-getannot (id &optional file-or-buffer)
"Return the annotation for ID.
ID should be a symbol, which was previously returned in a
`pdf-info-getannots' query. Signal an error, if an annotation
with ID is not available.
See `pdf-info-getannots' for the kind of return value of this
function."
(pdf-info-query
'getannot
(pdf-info--normalize-file-or-buffer file-or-buffer)
id))
(defun pdf-info-addannot (page edges type
&optional selection-style file-or-buffer
&rest markup-edges)
"Add a new annotation to PAGE with EDGES of TYPE.
FIXME: TYPE may be one of `text', `markup-highlight', ... .
FIXME: -1 = 24
See `pdf-info-getannots' for the kind of value of this function
returns."
(pdf-info-assert-writable-annotations)
(when (consp file-or-buffer)
(push file-or-buffer markup-edges)
(setq file-or-buffer nil))
(apply
#'pdf-info-query
'addannot
(pdf-info--normalize-file-or-buffer file-or-buffer)
page
type
(pdf-info--selection-style selection-style)
(mapconcat 'number-to-string edges " ")
(mapcar (lambda (me)
(mapconcat 'number-to-string me " "))
markup-edges)))
(defun pdf-info-delannot (id &optional file-or-buffer)
"Delete the annotation with ID in FILE-OR-BUFFER.
ID should be a symbol, which was previously returned in a
`pdf-info-getannots' query. Signal an error, if annotation ID
does not exist."
(pdf-info-assert-writable-annotations)
(pdf-info-query
'delannot
(pdf-info--normalize-file-or-buffer file-or-buffer)
id))
(defun pdf-info-mvannot (id edges &optional file-or-buffer)
"Move/Resize annotation ID to fit EDGES.
ID should be a symbol, which was previously returned in a
`pdf-info-getannots' query. Signal an error, if annotation ID
does not exist.
EDGES should be a list \(LEFT TOP RIGHT BOT\). RIGHT and/or BOT
may also be negative, which means to keep the width
resp. height."
(pdf-info-editannot id `((edges . ,edges)) file-or-buffer))
(defun pdf-info-editannot (id modifications &optional file-or-buffer)
"Edit annotation ID, applying MODIFICATIONS.
ID should be a symbol, which was previously returned in a
`pdf-info-getannots' query.
MODIFICATIONS is an alist of properties and their new values.
The server must support modifying annotations for this to work."
(pdf-info-assert-writable-annotations)
(let ((edits
(mapcar
(lambda (elt)
(cl-case (car elt)
(color
(list (car elt)
(pdf-util-hexcolor (cdr elt))))
(edges
(list (car elt)
(mapconcat 'number-to-string (cdr elt) " ")))
((popup-is-open is-open)
(list (car elt) (if (cdr elt) 1 0)))
(t
(list (car elt) (cdr elt)))))
modifications)))
(apply #'pdf-info-query
'editannot
(pdf-info--normalize-file-or-buffer file-or-buffer)
id
(apply #'append edits))))
(defun pdf-info-save (&optional file-or-buffer)
"Save FILE-OR-BUFFER.
This saves the document to a new temporary file, which is
returned and owned by the caller."
(pdf-info-assert-writable-annotations)
(pdf-info-query
'save
(pdf-info--normalize-file-or-buffer file-or-buffer)))
(defun pdf-info-getattachment-from-annot (id &optional do-save file-or-buffer)
"Return the attachment associated with annotation ID.
ID should be a symbol which was previously returned in a
`pdf-info-getannots' query, and referencing an attachment of type
`file', otherwise an error is signaled.
See `pdf-info-getattachments' for the kind of return value of this
function and the meaning of DO-SAVE."
(pdf-info-query
'getattachment-from-annot
(pdf-info--normalize-file-or-buffer file-or-buffer)
id
(if do-save 1 0)))
(defun pdf-info-getattachments (&optional do-save file-or-buffer)
"Return all document level attachments.
If DO-SAVE is non-nil, save the attachments data to a local file,
which is then owned by the caller, see below.
This function returns a list of alists, where every element
contains the following keys. All values, except for id, may be
nil, i.e. not present.
id - A symbol uniquely identifying this attachment.
filename - The filename of this attachment.
description - A description of this attachment.
size - The size in bytes.
modified - The last modification date.
created - The date of creation.
checksum - A MD5 checksum of this attachment's data.
file - The name of a tempfile containing the data (only present if
DO-SAVE is non-nil)."
(pdf-info-query
'getattachments
(pdf-info--normalize-file-or-buffer file-or-buffer)
(if do-save 1 0)))
(defun pdf-info-synctex-forward-search (source &optional line column file-or-buffer)
"Perform a forward search with synctex.
SOURCE should be a LaTeX buffer or the absolute filename of a
corresponding file. LINE and COLUMN represent the position in
the buffer or file. Finally FILE-OR-BUFFER corresponds to the
PDF document.
Returns an alist with entries PAGE and relative EDGES describing
the position in the PDF document corresponding to the SOURCE
location."
(let ((source (if (buffer-live-p (get-buffer source))
(buffer-file-name (get-buffer source))
source)))
(pdf-info-query
'synctex-forward-search
(pdf-info--normalize-file-or-buffer file-or-buffer)
source
(or line 1)
(or column 1))))
(defun pdf-info-synctex-backward-search (page &optional x y file-or-buffer)
"Perform a backward search with synctex.
Find the source location corresponding to the coordinates
\(X . Y\) on PAGE in FILE-OR-BUFFER.
Returns an alist with entries FILENAME, LINE and COLUMN."
(pdf-info-query
'synctex-backward-search
(pdf-info--normalize-file-or-buffer file-or-buffer)
page
(or x 0)
(or y 0)))
(defun pdf-info-renderpage (page width &optional file-or-buffer &rest commands)
"Render PAGE with width WIDTH.
Return the data of the corresponding PNG image."
(when (keywordp file-or-buffer)
(push file-or-buffer commands)
(setq file-or-buffer nil))
(apply #'pdf-info-query
'renderpage
(pdf-info--normalize-file-or-buffer file-or-buffer)
page
(* width (pdf-util-frame-scale-factor))
(let (transformed)
(while (cdr commands)
(let ((kw (pop commands))
(value (pop commands)))
(setq value
(cl-case kw
((:crop-to :highlight-line :highlight-region :highlight-text)
(mapconcat #'number-to-string value " "))
((:foreground :background)
(pdf-util-hexcolor value))
(:alpha
(number-to-string value))
(:selection-style
(number-to-string (pdf-info--selection-style value)))
(otherwise value)))
(push kw transformed)
(push value transformed)))
(when commands
(error "Keyword is missing a value: %s" (car commands)))
(nreverse transformed))))
(defun pdf-info-renderpage-text-regions (page width single-line-p
&optional selection-style file-or-buffer
&rest regions)
"Highlight text on PAGE with width WIDTH using REGIONS.
REGIONS is a list determining foreground and background color and
the regions to render. So each element should look like \(FG BG
\(LEFT TOP RIGHT BOT\) \(LEFT TOP RIGHT BOT\) ... \) . The
rendering is text-aware and is controlled by SELECTION-STYLE.
If SINGLE-LINE-P is non-nil, the edges in REGIONS are each
supposed to be limited to a single line in the document. Setting
this, if applicable, avoids rendering problems.
For the other args see `pdf-info-renderpage'.
Return the data of the corresponding PNG image."
(when (consp file-or-buffer)
(push file-or-buffer regions)
(setq file-or-buffer nil))
(apply #'pdf-info-renderpage
page width file-or-buffer
(apply #'append
`(:selection-style ,selection-style)
(mapcar (lambda (elt)
`(:foreground ,(pop elt)
:background ,(pop elt)
,@(cl-mapcan (lambda (edges)
`(,(if single-line-p
:highlight-line
:highlight-text)
,edges))
elt)))
regions))))
(defun pdf-info-renderpage-highlight (page width
&optional file-or-buffer
&rest regions)
"Highlight regions on PAGE with width WIDTH using REGIONS.
REGIONS is a list determining the background color, a alpha value
and the regions to render. So each element should look like \(FILL-COLOR
STROKE-COLOR ALPHA \(LEFT TOP RIGHT BOT\) \(LEFT TOP RIGHT BOT\) ... \)
.
For the other args see `pdf-info-renderpage'.
Return the data of the corresponding PNG image."
(when (consp file-or-buffer)
(push file-or-buffer regions)
(setq file-or-buffer nil))
(apply #'pdf-info-renderpage
page width file-or-buffer
(apply #'append
(mapcar (lambda (elt)
`(:background ,(pop elt)
:foreground ,(pop elt)
:alpha ,(pop elt)
,@(cl-mapcan (lambda (edges)
`(:highlight-region ,edges))
elt)))
regions))))
(defun pdf-info-boundingbox (page &optional file-or-buffer)
"Return a bounding-box for PAGE.
Returns a list \(LEFT TOP RIGHT BOT\)."
(pdf-info-query
'boundingbox
(pdf-info--normalize-file-or-buffer file-or-buffer)
page))
(defun pdf-info-getoptions (&optional file-or-buffer)
(pdf-info-query
'getoptions
(pdf-info--normalize-file-or-buffer file-or-buffer)))
(defun pdf-info-setoptions (&optional file-or-buffer &rest options)
(when (symbolp file-or-buffer)
(push file-or-buffer options)
(setq file-or-buffer nil))
(unless (= (% (length options) 2) 0)
(error "Missing a option value"))
(apply #'pdf-info-query
'setoptions
(pdf-info--normalize-file-or-buffer file-or-buffer)
(let (soptions)
(while options
(let ((key (pop options))
(value (pop options)))
(unless (and (keywordp key)
(not (eq key :)))
(error "Keyword expected: %s" key))
(cl-case key
((:render/foreground :render/background)
(push (pdf-util-hexcolor value)
soptions))
((:render/printed)
(push (if value 1 0) soptions))
((:render/usecolors)
;; 0 -> original color
;; 1 -> recolor document to grayscale mapping black to
;; :render/foreground and white to :render/background
;; 2 -> recolor document by inverting the perceived lightness
;; preserving hue
(push (if (and (integerp value) (> 3 value 0)) value 0)
soptions))
(t (push value soptions)))
(push key soptions)))
soptions)))
(defun pdf-info-pagelabels (&optional file-or-buffer)
"Return a list of pagelabels.
Returns a list of strings corresponding to the labels of the
pages in FILE-OR-BUFFER."
(pdf-info-query
'pagelabels
(pdf-info--normalize-file-or-buffer file-or-buffer)))
(defun pdf-info-ping (&optional message)
"Ping the server using MESSAGE.
Returns MESSAGE, which defaults to \"pong\"."
(pdf-info-query 'ping (or message "pong")))
(provide 'pdf-info)
;;; pdf-info.el ends here
Copy permalink