daniel/emacs
1
2
Fork 0
Code Issues 7 Pull Requests Projects Releases Wiki Activity

update packages

Browse Source
This commit is contained in:
Daniel Weschke
2022-01-04 21:35:17 +01:00
parent 1d5275c946
commit 8de00e5202
700 changed files with 42441 additions and 85378 deletions
Download Patch File Download Diff File Expand all files Collapse all files

228
lisp/pdf-tools/pdf-util.el
View File

@@ -25,6 +25,7 @@
;;; Code:
(require 'pdf-macs)
(require 'cl-lib)
(require 'format-spec)
(require 'faces)
@@ -33,10 +34,7 @@
;; which won't succeed, if pdf-view.el isn't loaded.
(declare-function pdf-view-image-size "pdf-view")
(declare-function pdf-view-image-offset "pdf-view")
(declare-function pdf-view-current-image "pdf-view")
(declare-function pdf-view-current-overlay "pdf-view")
(declare-function pdf-cache-pagesize "pdf-cache")
(declare-function pdf-view-image-type "pdf-view")
@@ -73,7 +71,7 @@ remove the entry if the new value is `eql' to DEFAULT."
(require 'register)
(unless (fboundp 'register-read-with-preview)
(defalias 'register-read-with-preview 'read-char
(defalias 'register-read-with-preview #'read-char
"Compatibility alias for pdf-tools."))
;; In Emacs 24.3 window-width does not have a PIXELWISE argument.
@@ -93,6 +91,7 @@ remove the entry if the new value is `eql' to DEFAULT."
(require 'image-mode)
(defvar image-mode-winprops-original-function
(symbol-function 'image-mode-winprops))
(defvar image-mode-winprops-alist)
(eval-after-load "image-mode"
'(defun image-mode-winprops (&optional window cleanup)
(if (not (eq major-mode 'pdf-view-mode))
@@ -304,6 +303,42 @@ See `pdf-util-scale' for the LIST-OF-EDGES-OR-POS argument."
result
(car result)))))
(defmacro pdf-util-with-edges (list-of-edges &rest body)
"Provide some convenient macros for the edges in LIST-OF-EDGES.
LIST-OF-EDGES should be a list of variables \(X ...\), each one
holding a list of edges. Inside BODY the symbols X-left, X-top,
X-right, X-bot, X-width and X-height expand to their respective
values."
(declare (indent 1) (debug (sexp &rest form)))
(unless (cl-every 'symbolp list-of-edges)
(error "Argument should be a list of symbols"))
(let ((list-of-syms
(mapcar (lambda (edge)
(cons edge (mapcar
(lambda (kind)
(intern (format "%s-%s" edge kind)))
'(left top right bot width height))))
list-of-edges)))
(macroexpand-all
`(cl-symbol-macrolet
,(apply #'nconc
(mapcar
(lambda (edge-syms)
(let ((edge (nth 0 edge-syms))
(syms (cdr edge-syms)))
`((,(pop syms) (nth 0 ,edge))
(,(pop syms) (nth 1 ,edge))
(,(pop syms) (nth 2 ,edge))
(,(pop syms) (nth 3 ,edge))
(,(pop syms) (- (nth 2 ,edge)
(nth 0 ,edge)))
(,(pop syms) (- (nth 3 ,edge)
(nth 1 ,edge))))))
list-of-syms))
,@body))))
(defun pdf-util-edges-transform (region elts &optional to-region-p)
"Translate ELTS according to REGION.
@@ -356,43 +391,6 @@ depending on the input."
result
(car result))))))
(defmacro pdf-util-with-edges (list-of-edges &rest body)
"Provide some convenient macros for the edges in LIST-OF-EDGES.
LIST-OF-EDGES should be a list of variables \(X ...\), each one
holding a list of edges. Inside BODY the symbols X-left, X-top,
X-right, X-bot, X-width and X-height expand to their respective
values."
(declare (indent 1) (debug (sexp &rest form)))
(unless (cl-every 'symbolp list-of-edges)
(error "Argument should be a list of symbols"))
(let ((list-of-syms
(mapcar (lambda (edge)
(cons edge (mapcar
(lambda (kind)
(intern (format "%s-%s" edge kind)))
'(left top right bot width height))))
list-of-edges)))
(macroexpand-all
`(cl-symbol-macrolet
,(apply 'nconc
(mapcar
(lambda (edge-syms)
(let ((edge (nth 0 edge-syms))
(syms (cdr edge-syms)))
`((,(pop syms) (nth 0 ,edge))
(,(pop syms) (nth 1 ,edge))
(,(pop syms) (nth 2 ,edge))
(,(pop syms) (nth 3 ,edge))
(,(pop syms) (- (nth 2 ,edge)
(nth 0 ,edge)))
(,(pop syms) (- (nth 3 ,edge)
(nth 1 ,edge))))))
list-of-syms))
,@body))))
;; * ================================================================== *
;; * Scrolling
;; * ================================================================== *
@@ -416,7 +414,7 @@ Returns a list of pixel edges."
(+ x0 (- (nth 2 edges) (nth 0 edges)))))
(y1 (min (cdr isize)
(+ y0 (- (nth 3 edges) (nth 1 edges))))))
(mapcar 'round (list x0 y0 x1 y1))))
(mapcar #'round (list x0 y0 x1 y1))))
(defun pdf-util-required-hscroll (edges &optional eager-p context-pixel)
"Return the amount of scrolling necessary, to make image EDGES visible.
@@ -467,9 +465,11 @@ Keep CONTEXT-PIXEL pixel of the image visible at the bottom and
top of the window. CONTEXT-PIXEL defaults to an equivalent pixel
value of `next-screen-context-lines'.
Return the required vscroll in lines or nil, if scrolling is not
needed."
Return the required vscroll in pixels or nil, if scrolling is not
needed.
Note: For versions of emacs before 27 this will return lines instead of
pixels. This is because of a change that occurred to `image-mode' in 27."
(pdf-util-assert-pdf-window)
(let* ((win (window-inside-pixel-edges))
(image-height (cdr (pdf-view-image-size t)))
@@ -483,20 +483,28 @@ needed."
(frame-char-height))))
;;Be careful not to modify edges.
(edges-top (- edges-top context-pixel))
(edges-bot (+ edges-bot context-pixel)))
(if (< edges-top image-top)
(round (/ (max 0 (if eager-p
(- edges-bot win-height)
edges-top))
(float (frame-char-height))))
(if (> (min image-height
edges-bot)
(+ image-top win-height))
(round (/ (min (- image-height win-height)
(if eager-p
edges-top
(- edges-bot win-height)))
(float (frame-char-height))))))))))
(edges-bot (+ edges-bot context-pixel))
(vscroll
(cond ((< edges-top image-top)
(max 0 (if eager-p
(- edges-bot win-height)
edges-top)))
((> (min image-height
edges-bot)
(+ image-top win-height))
(min (- image-height win-height)
(if eager-p
edges-top
(- edges-bot win-height)))))))
(when vscroll
(round
;; `image-set-window-vscroll' changed in version 27 to using
;; pixels, not lines.
(if (version< emacs-version "27")
(/ vscroll (float (frame-char-height)))
vscroll)))))))
(defun pdf-util-scroll-to-edges (edges &optional eager-p)
"Scroll window such that image EDGES are visible.
@@ -549,14 +557,9 @@ killed."
(let ((temporary-file-directory
pdf-util--base-directory))
(setq pdf-util--dedicated-directory
(make-temp-file (convert-standard-filename
(concat (if buffer-file-name
(file-name-nondirectory
buffer-file-name)
(buffer-name))
"-"))
(make-temp-file (convert-standard-filename (pdf-util-temp-prefix))
t))
(add-hook 'kill-buffer-hook 'pdf-util-delete-dedicated-directory
(add-hook 'kill-buffer-hook #'pdf-util-delete-dedicated-directory
nil t)))
pdf-util--dedicated-directory))
@@ -568,13 +571,21 @@ killed."
"Expand filename against current buffer's dedicated directory."
(expand-file-name name (pdf-util-dedicated-directory)))
(defun pdf-util-make-temp-file (prefix &optional dir-flag suffix)
(defun pdf-util-temp-prefix ()
"Create a temp-file prefix for the current buffer"
(concat (if buffer-file-name
(file-name-nondirectory buffer-file-name)
(replace-regexp-in-string "[^[:alnum:]]+" "-" (buffer-name)))
"-"))
(defun pdf-util-make-temp-file (&optional prefix dir-flag suffix)
"Create a temporary file in current buffer's dedicated directory.
See `make-temp-file' for the arguments."
(let ((temporary-file-directory
(pdf-util-dedicated-directory)))
(make-temp-file (convert-standard-filename prefix) dir-flag suffix)))
(let ((temporary-file-directory (pdf-util-dedicated-directory)))
(make-temp-file (convert-standard-filename
(or prefix (pdf-util-temp-prefix)))
dir-flag suffix)))
;; * ================================================================== *
@@ -636,7 +647,7 @@ Signal an error, if color is invalid."
(let ((values (color-values color)))
(unless values
(signal 'wrong-type-argument (list 'color-defined-p color)))
(apply 'format "#%02x%02x%02x"
(apply #'format "#%02x%02x%02x"
(mapcar (lambda (c) (lsh c -8))
values)))))
@@ -678,6 +689,10 @@ string."
,@tooltip-frame-parameters)))
(tooltip-show text)))
;; FIXME: Defined in `pdf-view' but we can't require it here because it
;; requires us :-(
(defvar pdf-view-midnight-colors)
(defun pdf-util-tooltip-arrow (image-top &optional timeout)
(pdf-util-assert-pdf-window)
(when (floatp image-top)
@@ -713,14 +728,18 @@ string."
'face `(:foreground
"orange red"
:background
,(if (bound-and-true-p pdf-view-midnight-minor-mode)
(cdr pdf-view-midnight-colors)
"white"))))
,(cond
((bound-and-true-p pdf-view-midnight-minor-mode)
(cdr pdf-view-midnight-colors))
((bound-and-true-p pdf-view-themed-minor-mode)
(face-background 'default nil))
(t "white")))))
dx dy)))
(defvar pdf-util--face-colors-cache (make-hash-table))
(defadvice enable-theme (after pdf-util-clear-faces-cache activate)
(advice-add 'enable-theme :after #'pdf-util--clear-faces-cache)
(defun pdf-util--clear-faces-cache (&rest _)
(clrhash pdf-util--face-colors-cache))
(defun pdf-util-face-colors (face &optional dark-p)
@@ -747,7 +766,7 @@ colors, otherwise light."
(let ((colors
(cons (face-attribute face :foreground nil 'default)
(face-attribute face :background nil 'default))))
(puthash face `(,(mapcar 'copy-sequence spec)
(puthash face `(,(mapcar #'copy-sequence spec)
((,bg . ,colors) ,@color-alist))
pdf-util--face-colors-cache)
colors)
@@ -844,15 +863,14 @@ them is nil, it means there is gap at this position in the
respective sequence."
(cl-macrolet ((make-matrix (rows columns)
(list 'apply (list 'quote 'vector)
(list 'cl-loop 'for 'i 'from 1 'to rows
'collect (list 'make-vector columns nil))))
`(apply #'vector
(cl-loop for i from 1 to ,rows
collect (make-vector ,columns nil))))
(mset (matrix row column newelt)
(list 'aset (list 'aref matrix row) column newelt))
`(aset (aref ,matrix ,row) ,column ,newelt))
(mref (matrix row column)
(list 'aref (list 'aref matrix row) column)))
(let* ((nil-value nil)
(len1 (length seq1))
`(aref (aref ,matrix ,row) ,column)))
(let* ((len1 (length seq1))
(len2 (length seq2))
(d (make-matrix (1+ len1) (1+ len2)))
(prefix-p (memq alignment-type '(prefix infix)))
@@ -888,7 +906,7 @@ respective sequence."
(= (mref d i j)
(1- (mref d (1- i) j))))
(cl-decf i)
(push (cons (elt seq1 i) nil-value) alignment))
(push (cons (elt seq1 i) nil) alignment))
((and (> j 0)
(= (mref d i j)
(+ (mref d i (1- j))
@@ -896,13 +914,14 @@ respective sequence."
(and (= i len1) prefix-p))
0 -1))))
(cl-decf j)
(push (cons nil-value (elt seq2 j)) alignment))
(push (cons nil (elt seq2 j)) alignment))
(t
(cl-assert (and (> i 0) (> j 0)) t)
(cl-decf i)
(cl-decf j)
(push (cons (elt seq1 i)
(elt seq2 j)) alignment))))
(elt seq2 j))
alignment))))
(cons (mref d len1 len2) alignment)))))
@@ -919,7 +938,7 @@ See also `regexp-quote'."
(when (memq ch to-escape)
(push ?\\ escaped))
(push ch escaped))
(apply 'string (nreverse escaped))))
(apply #'string (nreverse escaped))))
(defun pdf-util-frame-ppi ()
"Return the PPI of the current frame."
@@ -936,15 +955,14 @@ See also `regexp-quote'."
(defun pdf-util-frame-scale-factor ()
"Return the frame scale factor depending on the image type used for display.
When `pdf-view-use-scaling' is non-nil and imagemagick or
image-io are used as the image type for display, return the
backing-scale-factor of the frame if available. If a
backing-scale-factor attribute isn't available, return 2 if the
When `pdf-view-use-scaling' is non-nil, return the scale factor of the frame
if available. If the scale factor isn't available, return 2 if the
frame's PPI is larger than 180. Otherwise, return 1."
(if (and pdf-view-use-scaling
(memq (pdf-view-image-type) '(imagemagick image-io))
(fboundp 'frame-monitor-attributes))
(or (cdr (assq 'backing-scale-factor (frame-monitor-attributes)))
(if pdf-view-use-scaling
(or (and (fboundp 'frame-scale-factor)
(truncate (frame-scale-factor)))
(and (fboundp 'frame-monitor-attributes)
(cdr (assq 'backing-scale-factor (frame-monitor-attributes))))
(if (>= (pdf-util-frame-ppi) 180)
2
1))
@@ -1045,10 +1063,10 @@ of the last commands given earlier in SPEC. E.g. a call like
image-file out-file
:foreground \"black\"
:background \"white\"
:commands '\(\"-fill\" \"%f\" \"-draw\" \"rectangle %x,%y,%X,%Y\"\)
:apply '\(\(0 0 10 10\) \(10 10 20 20\)\)
:commands '\(\"-fill\" \"%b\" \"-draw\" \"rectangle %x,%y,%X,%Y\"\)
:apply '\(\(10 0 20 10\) \(0 10 10 20\)\)\)
:commands '(\"-fill\" \"%f\" \"-draw\" \"rectangle %x,%y,%X,%Y\")
:apply '((0 0 10 10) (10 10 20 20))
:commands '(\"-fill\" \"%b\" \"-draw\" \"rectangle %x,%y,%X,%Y\")
:apply '((10 0 20 10) (0 10 10 20)))
would draw a 4x4 checkerboard pattern in the left corner of the
image, while leaving the rest of it as it was.
@@ -1058,7 +1076,7 @@ Returns OUT-FILE.
See url `http://www.imagemagick.org/script/convert.php'."
(pdf-util-assert-convert-program)
(let* ((cmds (pdf-util-convert--create-commands spec))
(status (apply 'call-process
(status (apply #'call-process
pdf-util-convert-program nil
(get-buffer-create "*pdf-util-convert-output*")
nil
@@ -1083,7 +1101,7 @@ Returns the convert process."
callback nil))
(let* ((cmds (pdf-util-convert--create-commands spec))
(proc
(apply 'start-process "pdf-util-convert"
(apply #'start-process "pdf-util-convert"
(get-buffer-create "*pdf-util-convert-output*")
pdf-util-convert-program
`(,in-file ,@cmds ,out-file))))
@@ -1108,7 +1126,7 @@ Return the converted PNG image as a string. See also
(set-buffer-file-coding-system 'binary)
(insert image-data))
(pdf-util-munch-file
(apply 'pdf-util-convert
(apply #'pdf-util-convert
in-file out-file specs)))
(when (file-exists-p in-file)
(delete-file in-file))
@@ -1210,10 +1228,10 @@ If RELATIVE-P is non-nil, also check that all values <= 1."
(defun pdf-util-edges-union (&rest edges)
(if (null (cdr edges))
(car edges)
(list (apply 'min (mapcar 'car edges))
(apply 'min (mapcar 'cadr edges))
(apply 'max (mapcar 'cl-caddr edges))
(apply 'max (mapcar 'cl-cadddr edges)))))
(list (apply #'min (mapcar #'car edges))
(apply #'min (mapcar #'cadr edges))
(apply #'max (mapcar #'cl-caddr edges))
(apply #'max (mapcar #'cl-cadddr edges)))))
(defun pdf-util-edges-intersection-area (e1 e2)
(let ((inters (pdf-util-edges-intersection e1 e2)))