tools/pdf: refactor retina support advice #1667

modules/tools/pdf/autoload/pdf.el

@@ -1,111 +1,30 @@
 ;;; tools/pdf/autoload/pdf.el -*- lexical-binding: t; -*-
-;;;###autoload
-(defun *pdf-pdf-view-use-scaling-p ()
-  "Return t if scaling should be used."
-  (and (or (and (eq (framep-on-display) 'ns) (string-equal emacs-version "27.0.50"))
-           (memq (pdf-view-image-type)
-                 '(imagemagick image-io)))
-       pdf-view-use-scaling))
-;;;###autoload
-(defun *pdf-pdf-annot-show-annotation (a &optional highlight-p window)
-  "Make annotation A visible.
 
-Turn to A's page in WINDOW, and scroll it if necessary.
-
-If HIGHLIGHT-P is non-nil, visually distinguish annotation A from
-other annotations."
-
-  (save-selected-window
-    (when window (select-window window))
-    (pdf-util-assert-pdf-window)
-    (let* ((page (pdf-annot-get a 'page))
-           (size (pdf-view-image-size))
-           (width (car size)))
-      (unless (= page (pdf-view-current-page))
-        (pdf-view-goto-page page))
-      (let ((edges (pdf-annot-get-display-edges a)))
-        (when highlight-p
-          (pdf-view-display-image
-           (pdf-view-create-image
-               (pdf-cache-renderpage-highlight
-                page width
-                `("white" "steel blue" 0.35 ,@edges))
-             :map (pdf-view-apply-hotspot-functions
-                   window page size)
-             :width width)))
-        (pdf-util-scroll-to-edges
-         (pdf-util-scale-relative-to-pixel (car edges)))))))
 ;;;###autoload
-(defun *pdf-pdf-isearch-hl-matches (current matches &optional occur-hack-p)
+(defun +pdf--supply-width-to-create-image-calls-a (orig-fn &rest args)
-  "Highlighting edges CURRENT and MATCHES."
+  (cl-letf* ((old-create-image (symbol-function #'create-image))
-  (cl-check-type current pdf-isearch-match)
+             ((symbol-function #'create-image)
-  (cl-check-type matches (list-of pdf-isearch-match))
+              (lambda (file-or-data &optional type data-p &rest props)
-  (cl-destructuring-bind (fg1 bg1 fg2 bg2)
+                (apply old-create-image file-or-data type data-p
-      (pdf-isearch-current-colors)
+                       :width (car (pdf-view-image-size))
-    (let* ((width (car (pdf-view-image-size)))
+                       props))))
-           (page (pdf-view-current-page))
+    (apply orig-fn args)))
-           (window (selected-window))
+
-           (buffer (current-buffer))
-           (tick (cl-incf pdf-isearch--hl-matches-tick))
-           (pdf-info-asynchronous
-            (lambda (status data)
-              (when (and (null status)
-                         (eq tick pdf-isearch--hl-matches-tick)
-                         (buffer-live-p buffer)
-                         (window-live-p window)
-                         (eq (window-buffer window)
-                             buffer))
-                (with-selected-window window
-                  (when (and (derived-mode-p 'pdf-view-mode)
-                             (or isearch-mode
-                                 occur-hack-p)
-                             (eq page (pdf-view-current-page)))
-                    (pdf-view-display-image
-                     (pdf-view-create-image data
-                       :width width))))))))
-      (pdf-info-renderpage-text-regions
-       page width t nil
-       `(,fg1 ,bg1 ,@(pdf-util-scale-pixel-to-relative
-                      current))
-       `(,fg2 ,bg2 ,@(pdf-util-scale-pixel-to-relative
-                      (apply 'append
-                             (remove current matches))))))))
 ;;;###autoload
-(defun *pdf-pdf-util-frame-scale-factor ()
+(defun +pdf--util-frame-scale-factor-a (orig-fn)
-  "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
-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)))
+      (funcall orig-fn)
-          (if (>= (pdf-util-frame-ppi) 180)
+    ;; Add special support for retina displays on MacOS
-              2
+    (if (and (eq (framep-on-display) 'ns)
-            1))
+             EMACS27+)
-    (if (and (eq (framep-on-display) 'ns) (string-equal emacs-version "27.0.50"))
         2
       1)))
+
 ;;;###autoload
-(defun *pdf-pdf-view-display-region (&optional region rectangle-p)
+(defun +pdf--view-use-scaling-p-a (orig-fn)
-  ;; TODO: write documentation!
+  "Returns t if on ns window-system on Emacs 27+."
-  (unless region
+  (and (eq (framep-on-display) 'ns)
-    (pdf-view-assert-active-region)
+       EMACS27+
-    (setq region pdf-view-active-region))
+       pdf-view-use-scaling))
-  (let ((colors (pdf-util-face-colors
-                 (if rectangle-p 'pdf-view-rectangle 'pdf-view-region)
-                 (bound-and-true-p pdf-view-dark-minor-mode)))
-        (page (pdf-view-current-page))
-        (width (car (pdf-view-image-size))))
-    (pdf-view-display-image
-     (pdf-view-create-image
-         (if rectangle-p
-             (pdf-info-renderpage-highlight
-              page width nil
-              `(,(car colors) ,(cdr colors) 0.35 ,@region))
-           (pdf-info-renderpage-text-regions
-            page width nil nil
-            `(,(car colors) ,(cdr colors) ,@region)))
-       :width width))))

modules/tools/pdf/config.el

@@ -21,11 +21,22 @@
                 pdf-view-use-scaling t
                 pdf-view-use-imagemagick nil)
 
-  (advice-add 'pdf-annot-show-annotation :override #'*pdf-pdf-annot-show-annotation)
+  ;; Add retina support for MacOS users
-  (advice-add 'pdf-isearch-hl-matches :override #'*pdf-pdf-isearch-hl-matches)
+  (when IS-MAC
-  (advice-add 'pdf-util-frame-scale-factor :override #'*pdf-pdf-util-frame-scale-factor)
+    (advice-add #'pdf-util-frame-scale-factor :around #'+pdf--util-frame-scale-factor-a)
-  (advice-add 'pdf-view-display-region :override #'*pdf-pdf-view-display-region)
+    (advice-add #'pdf-view-use-scaling-p :before-until #'+pdf--view-use-scaling-p-a)
-  (advice-add 'pdf-view-use-scaling-p :override #'*pdf-pdf-view-use-scaling-p)
+    (defadvice! +pdf--supply-width-to-create-image-calls-a (orig-fn &rest args)
+      :around '(pdf-annot-show-annotation
+                pdf-isearch-hl-matches
+                pdf-view-display-region)
+      (cl-letf* ((old-create-image (symbol-function #'create-image))
+                 ((symbol-function #'create-image)
+                  (lambda (file-or-data &optional type data-p &rest props)
+                    (apply old-create-image file-or-data type data-p
+                           :width (car (pdf-view-image-size))
+                           props))))
+        (apply orig-fn args))))
+
   ;; Turn off cua so copy works
   (add-hook! 'pdf-view-mode-hook (cua-mode 0))
   ;; Handle PDF-tools related popups better