auctex-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[AUCTeX-diffs] [elpa] externals/auctex b21889e 19/30: Merge prv-emacs.el


From: Tassilo Horn
Subject: [AUCTeX-diffs] [elpa] externals/auctex b21889e 19/30: Merge prv-emacs.el into preview.el.in
Date: Fri, 25 Sep 2020 11:00:14 -0400 (EDT)

branch: externals/auctex
commit b21889e0f805ddaaea25317da2c872d90907d0c2
Author: Ikumi Keita <ikumi@ikumi.que.jp>
Commit: Ikumi Keita <ikumi@ikumi.que.jp>

    Merge prv-emacs.el into preview.el.in
    
    * preview.el.in: Merge all contents of prv-emacs.el.
    * prv-emacs.el: Delete.
    * Makefile.in:
    * configure.ac:
    Drop prv-emacs.el.
---
 Makefile.in   |   2 +-
 configure.ac  |   3 -
 preview.el.in | 512 +++++++++++++++++++++++++++++++++++++++++++++++-
 prv-emacs.el  | 609 ----------------------------------------------------------
 4 files changed, 511 insertions(+), 615 deletions(-)

diff --git a/Makefile.in b/Makefile.in
index 1037fe0..63234c1 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -177,7 +177,7 @@ STYLESRC = style/prosper.el \
 STYLEELC = $(STYLESRC:.el=.elc)
 
 ifeq (@preview_enabled@,yes)
-   PREVIEWSRC = @PLAT_LISP@ preview.el
+   PREVIEWSRC = preview.el
    PREVIEWELC = $(PREVIEWSRC:.el=.elc)
    PREVIEWLATEX = $(MAKE) preview-latex.el
    TEXMF = (cd latex ; $(MAKE) all)
diff --git a/configure.ac b/configure.ac
index 566378d..a31b049 100644
--- a/configure.ac
+++ b/configure.ac
@@ -55,8 +55,6 @@ AC_ARG_ENABLE(preview,
   [preview_enabled="yes"])
 AC_SUBST(preview_enabled)
 
-PLAT_LISP=prv-emacs.el
-
 EMACS_PATH_LISPDIR
 AC_MSG_CHECKING(what file to use for auctex startup)
 AC_ARG_WITH(auctexstartfile,
@@ -92,7 +90,6 @@ texsitedir="${lispdir}"
 
 AC_SUBST(auctexstartfile)
 AC_SUBST(previewstartfile)
-AC_SUBST(PLAT_LISP)
 
 AC_MSG_CHECKING([where the package lisp files go])
 AC_ARG_WITH(packagelispdir,
diff --git a/preview.el.in b/preview.el.in
index 46fcd90..c14e490 100644
--- a/preview.el.in
+++ b/preview.el.in
@@ -55,8 +55,6 @@ preview-latex buffers will not survive across sessions.")))
 preview-latex's bug reporting commands will probably not work.")))
   (require 'info))
 
-(require 'prv-emacs)
-
 (defgroup preview nil "Embed Preview images into LaTeX buffers."
   :group 'AUCTeX
   :prefix "preview-"
@@ -887,6 +885,10 @@ Pure borderless black-on-white will return an empty 
string."
      (and border
          (format "--bd %d" (max 1 (round (/ (* res border) 72.0))))))))
 
+(defsubst preview-supports-image-type (imagetype)
+  "Check if IMAGETYPE is supported."
+  (image-type-available-p imagetype))
+
 (defun preview-gs-dvips-process-setup ()
   "Set up Dvips process for conversions via gs."
   (unless (preview-supports-image-type preview-gs-image-type)
@@ -1198,6 +1200,26 @@ is located."
       (push ov preview-gs-queue)))
   t)
 
+(defsubst preview-icon-copy (icon)
+  "Prepare a later call of `preview-replace-active-icon'."
+
+  ;; This is just a GNU Emacs specific efficiency hack because it
+  ;; is easy to do.  When porting, don't do anything complicated
+  ;; here, rather deliver just the unchanged icon and make
+  ;; `preview-replace-active-icon' do the necessary work of replacing
+  ;; the icon where it actually has been stored, probably
+  ;; in the car of the strings property of the overlay.  This string
+  ;; might probably serve as a begin-glyph as well, in which case
+  ;; modifying the string in the strings property would change that
+  ;; glyph automatically.
+
+  (cons 'image (cdr icon)))
+
+(defsubst preview-replace-active-icon (ov replacement)
+  "Replace the active Icon in OV by REPLACEMENT, another icon."
+  (let ((img (overlay-get ov 'preview-image)))
+    (setcdr (car img) (cdar replacement))
+    (setcdr img (cdr replacement))))
 
 (defun preview-gs-place (ov snippet box run-buffer tempdir ps-file _imagetype)
   "Generate an image placeholder rendered over by Ghostscript.
@@ -1226,6 +1248,35 @@ for the file extension."
 
 (defvar view-exit-action)
 
+(eval-and-compile
+  (defvar preview-button-1 [mouse-2])
+  (defvar preview-button-2 [mouse-3]))
+
+(defmacro preview-make-clickable (&optional map glyph helpstring click1 click2)
+  "Generate a clickable string or keymap.
+If MAP is non-nil, it specifies a keymap to add to, otherwise
+a new one is created.  If GLYPH is given, the result is made
+to display it wrapped in a string.  In that case,
+HELPSTRING is a format string with one or two %s specifiers
+for preview's clicks, displayed as a help-echo.  CLICK1 and CLICK2
+are functions to call on preview's clicks."
+  `(let ((resmap ,(or map '(make-sparse-keymap))))
+     ,@(if click1
+           `((define-key resmap preview-button-1 ,click1)))
+     ,@(if click2
+           `((define-key resmap preview-button-2 ,click2)))
+     ,(if glyph
+         `(propertize
+           "x"
+           'display ,glyph
+           'mouse-face 'highlight
+           'help-echo
+           ,(if (stringp helpstring)
+                (format helpstring preview-button-1 preview-button-2)
+              `(format ,helpstring preview-button-1 preview-button-2))
+           'keymap resmap)
+       'resmap)))
+
 (defun preview-mouse-open-error (string)
   "Display STRING in a new view buffer on click."
   (let ((buff (get-buffer-create
@@ -1423,6 +1474,13 @@ recursively."
         (symbol-value hook))
        (t hook)))
 
+(defun preview-inherited-face-attribute (face attribute &optional inherit)
+  "Fetch face attribute while adhering to inheritance.
+This searches FACE for an ATTRIBUTE, using INHERIT
+for resolving unspecified or relative specs.  See the fourth
+argument of function `face-attribute' for details."
+  (face-attribute face attribute nil inherit))
+
 (defcustom preview-scale-function #'preview-scale-from-face
   "*Scale factor for included previews.
 This can be either a function to calculate the scale, or
@@ -1623,6 +1681,409 @@ considered unchanged."
   :group 'preview-appearance
   :type '(repeat function))
 
+(defcustom preview-transparent-color '(highlight :background)
+  "Color to appear transparent in previews.
+Set this to something unusual when using `preview-transparent-border',
+to the default background in most other cases."
+  :type '(radio (const :tag "None" nil)
+                (const :tag "Autodetect" t)
+                (color :tag "By name" :value "white")
+                (list :tag "Take from face"
+                      :value (default :background)
+                      (face)
+                      (choice :tag "What to take"
+                       (const :tag "Background" :value :background)
+                       (const :tag "Foreground" :value :foreground))))
+  :group 'preview-appearance)
+
+;;; Note that the following default introduces a border only when
+;;; Emacs blinks politely when point is on an image (the tested
+;;; unrelated function was introduced at about the time image blinking
+;;; became tolerable).
+(defcustom preview-transparent-border (unless (fboundp 'posn-object-x-y) 1.5)
+  "Width of transparent border for previews in pt.
+Setting this to a numeric value will add a border of
+`preview-transparent-color' around images, and will turn
+the heuristic-mask setting of images to default to 't since
+then the borders are correctly detected even in case of
+palette operations.  If the transparent color is something
+not present otherwise in the image, the cursor display
+will affect just this border.  A width of 0 is interpreted
+by PostScript as meaning a single pixel, other widths are
+interpreted as PostScript points (1/72 of 1in)"
+  :group 'preview-appearance
+  :type '(choice (const :value nil :tag "No border")
+                (number :value 1.5 :tag "Border width in pt")))
+
+(defun preview-get-heuristic-mask ()
+  "Get heuristic-mask to use for previews.
+Consults `preview-transparent-color'."
+  (cond ((stringp preview-transparent-color)
+        (color-values preview-transparent-color))
+       ((or (not (consp preview-transparent-color))
+            (integerp (car preview-transparent-color)))
+        preview-transparent-color)
+       (t (color-values (preview-inherited-face-attribute
+                         (nth 0 preview-transparent-color)
+                         (nth 1 preview-transparent-color)
+                         'default)))))
+
+(defsubst preview-create-icon-1 (file type ascent border)
+  `(image
+    :file ,file
+    :type ,type
+    :ascent ,ascent
+    ,@(and border
+          '(:mask (heuristic t)))))
+
+(defun preview-create-icon (file type ascent border)
+  "Create an icon from FILE, image TYPE, ASCENT and BORDER."
+  (list
+   (preview-create-icon-1 file type ascent border)
+   file type ascent border))
+
+(put 'preview-filter-specs :type
+     (lambda (keyword value &rest args)
+       (if (image-type-available-p value)
+          `(image :type ,value
+                  ,@(preview-filter-specs-1 args))
+        (throw 'preview-filter-specs nil))))
+
+(defun preview-import-image (image)
+  "Convert the printable IMAGE rendition back to an image."
+  (cond ((stringp image)
+        (propertize image 'face 'preview-face))
+       ((eq (car image) 'image)
+        image)
+       (t
+        (preview-create-icon-1 (nth 0 image)
+                               (nth 1 image)
+                               (nth 2 image)
+                               (if (< (length image) 4)
+                                   (preview-get-heuristic-mask)
+                                 (nth 3 image))))))
+
+;; No defcustom here: does not seem to make sense.
+
+(defvar preview-tb-icon-specs
+  '((:type xpm :file "prvtex24.xpm")
+    (:type xbm :file "prvtex24.xbm")))
+
+(defvar preview-tb-icon nil)
+
+(defun preview-add-urgentization (fun ov &rest rest)
+  "Cause FUN (function call form) to be called when redisplayed.
+FUN must be a form with OV as first argument,
+REST as the remainder, returning T."
+  (let ((dispro (overlay-get ov 'display)))
+    (unless (eq (car dispro) 'when)
+      (overlay-put ov 'display `(when (,fun ,ov ,@rest)  . ,dispro)))))
+
+(defun preview-remove-urgentization (ov)
+  "Undo urgentization of OV by `preview-add-urgentization'.
+Returns the old arguments to `preview-add-urgentization'
+if there was any urgentization."
+  (let ((dispro (overlay-get ov 'display)))
+    (when (eq (car-safe dispro) 'when)
+      (prog1
+         (car (cdr dispro))
+       (overlay-put ov 'display (cdr (cdr dispro)))))))
+
+(defvar preview-overlay nil)
+
+(put 'preview-overlay
+     'modification-hooks
+     '(preview-handle-modification))
+
+(put 'preview-overlay
+     'insert-in-front-hooks
+     '(preview-handle-insert-in-front))
+
+(put 'preview-overlay
+     'insert-behind-hooks
+     '(preview-handle-insert-behind))
+
+;; We have to fake our way around atomicity.
+
+;; Here is the beef: for best intuitiveness, we want to have
+;; insertions be carried out as expected before iconized text
+;; passages, but we want to insert *into* the overlay when not
+;; iconized.  A preview that has become empty can not get content
+;; again: we remove it.  A disabled preview needs no insert-in-front
+;; handler.
+
+(defvar preview-change-list nil
+  "List of tentatively changed overlays.")
+
+(defcustom preview-dump-threshold
+  "^ *\\\\begin *{document}[ %]*$"
+  "*Regexp denoting end of preamble.
+This is the location up to which preamble changes are considered
+to require redumping of a format."
+  :group 'preview-latex
+  :type 'string)
+
+(defun preview-preamble-changed-function
+  (ov after-change beg end &optional length)
+  "Hook function for change hooks on preamble.
+See info node `(elisp) Overlay Properties' for
+definition of OV, AFTER-CHANGE, BEG, END and LENGTH."
+  (let ((format-cons (overlay-get ov 'format-cons)))
+    (preview-unwatch-preamble format-cons)
+    (preview-format-kill format-cons)
+    (setcdr format-cons t)))
+
+(defun preview-watch-preamble (file command format-cons)
+  "Set up a watch on master file FILE.
+FILE can be an associated buffer instead of a filename.
+COMMAND is the command that generated the format.
+FORMAT-CONS contains the format info for the main
+format dump handler."
+  (let ((buffer (if (bufferp file)
+                   file
+                 (find-buffer-visiting file))) ov)
+    (setcdr
+     format-cons
+     (cons command
+          (when buffer
+            (with-current-buffer buffer
+              (save-excursion
+                (save-restriction
+                  (widen)
+                  (goto-char (point-min))
+                  (unless (re-search-forward preview-dump-threshold nil t)
+                    (error "Can't find preamble of `%s'" file))
+                  (setq ov (make-overlay (point-min) (point)))
+                  (overlay-put ov 'format-cons format-cons)
+                  (overlay-put ov 'insert-in-front-hooks
+                               '(preview-preamble-changed-function))
+                  (overlay-put ov 'modification-hooks
+                               '(preview-preamble-changed-function))
+                  ov))))))))
+
+(defun preview-unwatch-preamble (format-cons)
+  "Stop watching a format on FORMAT-CONS.
+The watch has been set up by `preview-watch-preamble'."
+  (when (consp (cdr format-cons))
+    (when (cddr format-cons)
+      (delete-overlay (cddr format-cons)))
+    (setcdr (cdr format-cons) nil)))
+
+(defun preview-register-change (ov)
+  "Register not yet changed OV for verification.
+This stores the old contents of the overlay in the
+`preview-prechange' property and puts the overlay into
+`preview-change-list' where `preview-check-changes' will
+find it at some later point of time."
+  (unless (overlay-get ov 'preview-prechange)
+    (if (eq (overlay-get ov 'preview-state) 'disabled)
+       (overlay-put ov 'preview-prechange t)
+      (overlay-put ov 'preview-prechange
+                  (save-restriction
+                    (widen)
+                    (buffer-substring-no-properties
+                     (overlay-start ov) (overlay-end ov)))))
+    (push ov preview-change-list)))
+
+(defun preview-check-changes ()
+  "Check whether the contents under the overlay have changed.
+Disable it if that is the case.  Ignores text properties."
+  (dolist (ov preview-change-list)
+    (condition-case nil
+       (with-current-buffer (overlay-buffer ov)
+         (let ((text (save-restriction
+                       (widen)
+                       (buffer-substring-no-properties
+                        (overlay-start ov) (overlay-end ov)))))
+           (if (zerop (length text))
+               (preview-delete ov)
+             (unless
+                 (or (eq (overlay-get ov 'preview-state) 'disabled)
+                     (preview-relaxed-string=
+                      text (overlay-get ov 'preview-prechange)))
+               (overlay-put ov 'insert-in-front-hooks nil)
+               (overlay-put ov 'insert-behind-hooks nil)
+               (preview-disable ov)))))
+      (error nil))
+    (overlay-put ov 'preview-prechange nil))
+  (setq preview-change-list nil))
+
+(defun preview-handle-insert-in-front
+  (ov after-change beg end &optional length)
+  "Hook function for `insert-in-front-hooks' property.
+See info node `(elisp) Overlay Properties' for
+definition of OV, AFTER-CHANGE, BEG, END and LENGTH."
+  (if after-change
+      (unless undo-in-progress
+       (if (eq (overlay-get ov 'preview-state) 'active)
+           (move-overlay ov end (overlay-end ov))))
+    (preview-register-change ov)))
+
+(defun preview-handle-insert-behind
+  (ov after-change beg end &optional length)
+  "Hook function for `insert-behind-hooks' property.
+This is needed in case `insert-before-markers' is used at the
+end of the overlay.  See info node `(elisp) Overlay Properties'
+for definition of OV, AFTER-CHANGE, BEG, END and LENGTH."
+  (if after-change
+      (unless undo-in-progress
+       (if (eq (overlay-get ov 'preview-state) 'active)
+           (move-overlay ov (overlay-start ov) beg)))
+    (preview-register-change ov)))
+
+(defun preview-handle-modification
+  (ov after-change beg end &optional length)
+  "Hook function for `modification-hooks' property.
+See info node `(elisp) Overlay Properties' for
+definition of OV, AFTER-CHANGE, BEG, END and LENGTH."
+  (unless after-change
+    (preview-register-change ov)))
+
+(defun preview-toggle (ov &optional arg event)
+  "Toggle visibility of preview overlay OV.
+ARG can be one of the following: t displays the overlay,
+nil displays the underlying text, and 'toggle toggles.
+If EVENT is given, it indicates the window where the event
+occured, either by being a mouse event or by directly being
+the window in question.  This may be used for cursor restoration
+purposes."
+  (let ((old-urgent (preview-remove-urgentization ov))
+       (preview-state
+        (if (if (eq arg 'toggle)
+                (null (eq (overlay-get ov 'preview-state) 'active))
+              arg)
+            'active
+          'inactive))
+       (strings (overlay-get ov 'strings)))
+    (unless (eq (overlay-get ov 'preview-state) 'disabled)
+      (overlay-put ov 'preview-state preview-state)
+      (if (eq preview-state 'active)
+         (progn
+           (overlay-put ov 'category 'preview-overlay)
+           (if (eq (overlay-start ov) (overlay-end ov))
+               (overlay-put ov 'before-string (car strings))
+             (dolist (prop '(display keymap mouse-face help-echo))
+               (overlay-put ov prop
+                            (get-text-property 0 prop (car strings))))
+             (overlay-put ov 'before-string nil))
+           (overlay-put ov 'face nil))
+       (dolist (prop '(display keymap mouse-face help-echo))
+         (overlay-put ov prop nil))
+       (overlay-put ov 'face 'preview-face)
+       (unless (cdr strings)
+         (setcdr strings (preview-inactive-string ov)))
+       (overlay-put ov 'before-string (cdr strings)))
+      (if old-urgent
+         (apply 'preview-add-urgentization old-urgent))))
+  (if event
+      (preview-restore-position
+       ov
+       (if (windowp event)
+          event
+        (posn-window (event-start event))))))
+
+(defvar preview-marker (make-marker)
+  "Marker for fake intangibility.")
+
+(defvar preview-temporary-opened nil)
+
+(defvar preview-last-location nil
+  "Restored cursor position marker for reopened previews.")
+(make-variable-buffer-local 'preview-last-location)
+
+(defun preview-mark-point ()
+  "Mark position for fake intangibility."
+  (when (eq (get-char-property (point) 'preview-state) 'active)
+    (unless preview-last-location
+      (setq preview-last-location (make-marker)))
+    (set-marker preview-last-location (point))
+    (set-marker preview-marker (point))
+    (preview-move-point))
+  (set-marker preview-marker (point)))
+
+(defun preview-restore-position (ov window)
+  "Tweak position after opening/closing preview.
+The treated overlay OV has been triggered in WINDOW.  This function
+records the original buffer position for reopening, or restores it
+after reopening.  Note that by using the mouse, you can open/close
+overlays not in the active window."
+  (when (eq (overlay-buffer ov) (window-buffer window))
+    (with-current-buffer (overlay-buffer ov)
+      (if (eq (overlay-get ov 'preview-state) 'active)
+         (setq preview-last-location
+               (set-marker (or preview-last-location (make-marker))
+                           (window-point window)))
+       (when (and
+              (markerp preview-last-location)
+              (eq (overlay-buffer ov) (marker-buffer preview-last-location))
+              (< (overlay-start ov) preview-last-location)
+              (> (overlay-end ov) preview-last-location))
+         (set-window-point window preview-last-location))))))
+
+(defun preview-move-point ()
+  "Move point out of fake-intangible areas."
+  (preview-check-changes)
+  (let* (newlist (pt (point)) (lst (overlays-at pt)) distance)
+    (setq preview-temporary-opened
+         (dolist (ov preview-temporary-opened newlist)
+           (and (overlay-buffer ov)
+                (eq (overlay-get ov 'preview-state) 'inactive)
+                (if (and (eq (overlay-buffer ov) (current-buffer))
+                         (or (<= pt (overlay-start ov))
+                             (>= pt (overlay-end ov))))
+                    (preview-toggle ov t)
+                  (push ov newlist)))))
+    (when lst
+      (if (or disable-point-adjustment
+             global-disable-point-adjustment
+             (preview-auto-reveal-p
+              preview-auto-reveal
+              (setq distance
+                    (and (eq (marker-buffer preview-marker)
+                             (current-buffer))
+                         (- pt (marker-position preview-marker))))))
+         (preview-open-overlays lst)
+       (while lst
+         (setq lst
+               (if (and
+                    (eq (overlay-get (car lst) 'preview-state) 'active)
+                    (> pt (overlay-start (car lst))))
+                   (overlays-at
+                    (setq pt (if (and distance (< distance 0))
+                                 (overlay-start (car lst))
+                               (overlay-end (car lst)))))
+                 (cdr lst))))
+       (goto-char pt)))))
+
+(defun preview-open-overlays (list &optional pos)
+  "Open all previews in LIST, optionally restricted to enclosing POS."
+  (dolist (ovr list)
+    (when (and (eq (overlay-get ovr 'preview-state) 'active)
+              (or (null pos)
+                  (and
+                   (> pos (overlay-start ovr))
+                   (< pos (overlay-end ovr)))))
+      (preview-toggle ovr)
+      (push ovr preview-temporary-opened))))
+
+(defadvice replace-highlight (before preview)
+  "Make `query-replace' open preview text about to be replaced."
+  (preview-open-overlays
+   (overlays-in (ad-get-arg 0) (ad-get-arg 1))))
+
+(defcustom preview-query-replace-reveal t
+  "*Make `query-replace' autoreveal previews."
+  :group 'preview-appearance
+  :type 'boolean
+  :require 'preview
+  :set (lambda (symbol value)
+        (set-default symbol value)
+        (if value
+            (ad-enable-advice 'replace-highlight 'before 'preview)
+          (ad-disable-advice 'replace-highlight 'before 'preview))
+        (ad-activate 'replace-highlight))
+  :initialize #'custom-initialize-reset)
+
 (defun preview-relaxed-string= (&rest args)
 "Check for functional equality of arguments.
 The arguments ARGS are checked for equality by using
@@ -2581,6 +3042,32 @@ pp")
       (customize-save-variable 'preview-TeX-style-dir nil)
     (customize-set-variable 'preview-TeX-style-dir nil)))
 
+(defun preview-mode-setup ()
+  "Setup proper buffer hooks and behavior for previews."
+  (set (make-local-variable 'desktop-save-buffer)
+       #'desktop-buffer-preview-misc-data)
+  (add-hook 'pre-command-hook #'preview-mark-point nil t)
+  (add-hook 'post-command-hook #'preview-move-point nil t)
+  (unless preview-tb-icon
+    (setq preview-tb-icon (preview-filter-specs preview-tb-icon-specs)))
+  (when preview-tb-icon
+    (define-key LaTeX-mode-map [tool-bar preview]
+      `(menu-item "Preview at point" preview-at-point
+                 :image ,preview-tb-icon
+                 :help "Preview on/off at point")))
+  (when buffer-file-name
+    (let* ((filename (expand-file-name buffer-file-name))
+          format-cons)
+      (when (string-match (concat "\\." TeX-default-extension "\\'")
+                         filename)
+       (setq filename (substring filename 0 (match-beginning 0))))
+      (setq format-cons (assoc filename preview-dumped-alist))
+      (when (consp (cdr format-cons))
+       (preview-unwatch-preamble format-cons)
+       (preview-watch-preamble (current-buffer)
+                               (cadr format-cons)
+                               format-cons)))))
+
 ;;;###autoload
 (defun LaTeX-preview-setup ()
   "Hook function for embedding the preview package into AUCTeX.
@@ -3152,6 +3639,27 @@ and `preview-colors' are set as given."
        preview-resolution (nth 1 geometry)
        preview-colors (nth 2 geometry)))
 
+(defun preview-get-colors ()
+  "Return colors from the current display.
+Fetches the current screen colors and makes a vector
+of colors as numbers in the range 0..65535.
+Pure borderless black-on-white will return triple NIL.
+The fourth value is the transparent border thickness."
+  (let
+      ((bg (color-values (preview-inherited-face-attribute
+                         'preview-reference-face :background 'default)))
+       (fg (color-values (preview-inherited-face-attribute
+                         'preview-reference-face :foreground 'default)))
+       (mask (preview-get-heuristic-mask)))
+    (if (equal '(65535 65535 65535) bg)
+       (setq bg nil))
+    (if (equal '(0 0 0) fg)
+       (setq fg nil))
+    (unless (and (numberp preview-transparent-border)
+                (consp mask) (integerp (car mask)))
+      (setq mask nil))
+    (vector bg fg mask preview-transparent-border)))
+
 (defun preview-start-dvipng ()
   "Start a DviPNG process.."
   (let* ((file preview-gs-file)
diff --git a/prv-emacs.el b/prv-emacs.el
deleted file mode 100644
index 2d9a6ef..0000000
--- a/prv-emacs.el
+++ /dev/null
@@ -1,609 +0,0 @@
-;;; prv-emacs.el --- GNU Emacs specific code for preview.el
-
-;; Copyright (C) 2001-2005, 2018, 2019  Free Software Foundation, Inc.
-
-;; Author: David Kastrup
-;; Keywords: convenience, tex, wp
-
-;; This file 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, or (at your option)
-;; any later version.
-
-;; This file 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 GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; 
-
-;;; Code:
-
-(require 'tex-site)
-(require 'tex)
-(require 'latex)
-
-;; Silence the compiler for functions:
-(declare-function preview-inherited-face-attribute "prv-emacs"
-                 (face attribute &optional inherit))
-(declare-function preview-filter-specs-1 "preview"
-                 (specs))
-(declare-function preview-format-kill "preview"
-                 (format-cons))
-(declare-function preview-delete "preview"
-                 (ovr &rest ignored))
-(declare-function preview-relaxed-string= "preview"
-                 (&rest args))
-(declare-function preview-disable "preview"
-                 (ovr))
-(declare-function preview-inactive-string "preview"
-                 (ov))
-(declare-function preview-filter-specs "preview"
-                 (spec-list))
-(declare-function preview-auto-reveal-p "preview"
-                 (mode distance))
-(declare-function desktop-buffer-preview-misc-data "preview"
-                 (&rest ignored))
-
-(defcustom preview-transparent-color '(highlight :background)
-  "Color to appear transparent in previews.
-Set this to something unusual when using `preview-transparent-border',
-to the default background in most other cases."
-  :type '(radio (const :tag "None" nil)
-               (const :tag "Autodetect" t)
-               (color :tag "By name" :value "white")
-               (list :tag "Take from face"
-                     :value (default :background)
-                     (face)
-                     (choice :tag "What to take"
-                             (const :tag "Background" :value :background)
-                             (const :tag "Foreground" :value :foreground))))
-  :group 'preview-appearance)
-
-;;; Note that the following default introduces a border only when
-;;; Emacs blinks politely when point is on an image (the tested
-;;; unrelated function was introduced at about the time image blinking
-;;; became tolerable).
-(defcustom preview-transparent-border (unless (fboundp 'posn-object-x-y) 1.5)
-  "Width of transparent border for previews in pt.
-Setting this to a numeric value will add a border of
-`preview-transparent-color' around images, and will turn
-the heuristic-mask setting of images to default to 't since
-then the borders are correctly detected even in case of
-palette operations.  If the transparent color is something
-not present otherwise in the image, the cursor display
-will affect just this border.  A width of 0 is interpreted
-by PostScript as meaning a single pixel, other widths are
-interpreted as PostScript points (1/72 of 1in)"
-  :group 'preview-appearance
-  :type '(choice (const :value nil :tag "No border")
-                (number :value 1.5 :tag "Border width in pt")))
-
-(defun preview-get-heuristic-mask ()
-  "Get heuristic-mask to use for previews.
-Consults `preview-transparent-color'."
-  (cond ((stringp preview-transparent-color)
-        (color-values preview-transparent-color))
-       ((or (not (consp preview-transparent-color))
-            (integerp (car preview-transparent-color)))
-        preview-transparent-color)
-       (t (color-values (preview-inherited-face-attribute
-                         (nth 0 preview-transparent-color)
-                         (nth 1 preview-transparent-color)
-                         'default)))))
-
-(defsubst preview-create-icon-1 (file type ascent border)
-  `(image
-    :file ,file
-    :type ,type
-    :ascent ,ascent
-    ,@(and border
-          '(:mask (heuristic t)))))
-
-(defun preview-create-icon (file type ascent border)
-  "Create an icon from FILE, image TYPE, ASCENT and BORDER."
-  (list
-   (preview-create-icon-1 file type ascent border)
-   file type ascent border))
-
-(put 'preview-filter-specs :type
-     #'(lambda (keyword value &rest args)
-        (if (image-type-available-p value)
-            `(image :type ,value
-                    ,@(preview-filter-specs-1 args))
-          (throw 'preview-filter-specs nil))))
-
-;; No defcustom here: does not seem to make sense.
-
-(defvar preview-tb-icon-specs
-  '((:type xpm :file "prvtex24.xpm")
-    (:type xbm :file "prvtex24.xbm")))
-
-(defvar preview-tb-icon nil)
-
-(defun preview-add-urgentization (fun ov &rest rest)
-  "Cause FUN (function call form) to be called when redisplayed.
-FUN must be a form with OV as first argument,
-REST as the remainder, returning T."
-  (let ((dispro (overlay-get ov 'display)))
-    (unless (eq (car dispro) 'when)
-      (overlay-put ov 'display `(when (,fun ,ov ,@rest)  . ,dispro)))))
-
-(defun preview-remove-urgentization (ov)
-  "Undo urgentization of OV by `preview-add-urgentization'.
-Returns the old arguments to `preview-add-urgentization'
-if there was any urgentization."
-  (let ((dispro (overlay-get ov 'display)))
-    (when (eq (car-safe dispro) 'when)
-      (prog1
-         (car (cdr dispro))
-       (overlay-put ov 'display (cdr (cdr dispro)))))))
-
-(defsubst preview-icon-copy (icon)
-  "Prepare a later call of `preview-replace-active-icon'."
-
-  ;; This is just a GNU Emacs specific efficiency hack because it
-  ;; is easy to do.  When porting, don't do anything complicated
-  ;; here, rather deliver just the unchanged icon and make
-  ;; `preview-replace-active-icon' do the necessary work of replacing
-  ;; the icon where it actually has been stored, probably
-  ;; in the car of the strings property of the overlay.  This string
-  ;; might probably serve as a begin-glyph as well, in which case
-  ;; modifying the string in the strings property would change that
-  ;; glyph automatically.
-
-  (cons 'image (cdr icon)))
-
-(defsubst preview-replace-active-icon (ov replacement)
-  "Replace the active Icon in OV by REPLACEMENT, another icon."
-  (let ((img (overlay-get ov 'preview-image)))
-    (setcdr (car img) (cdar replacement))
-    (setcdr img (cdr replacement))))
-
-(defvar preview-button-1 [mouse-2])
-(defvar preview-button-2 [mouse-3])
-
-(defmacro preview-make-clickable (&optional map glyph helpstring click1 click2)
-  "Generate a clickable string or keymap.
-If MAP is non-nil, it specifies a keymap to add to, otherwise
-a new one is created.  If GLYPH is given, the result is made
-to display it wrapped in a string.  In that case,
-HELPSTRING is a format string with one or two %s specifiers
-for preview's clicks, displayed as a help-echo.  CLICK1 and CLICK2
-are functions to call on preview's clicks."
-  `(let ((resmap ,(or map '(make-sparse-keymap))))
-     ,@(if click1
-           `((define-key resmap preview-button-1 ,click1)))
-     ,@(if click2
-           `((define-key resmap preview-button-2 ,click2)))
-     ,(if glyph
-         `(propertize
-           "x"
-           'display ,glyph
-           'mouse-face 'highlight
-           'help-echo
-           ,(if (stringp helpstring)
-                (format helpstring preview-button-1 preview-button-2)
-              `(format ,helpstring preview-button-1 preview-button-2))
-           'keymap resmap)
-       'resmap)))
-
-(defvar preview-overlay nil)
-
-(put 'preview-overlay
-     'modification-hooks
-     '(preview-handle-modification))
-
-(put 'preview-overlay
-     'insert-in-front-hooks
-     '(preview-handle-insert-in-front))
-
-(put 'preview-overlay
-     'insert-behind-hooks
-     '(preview-handle-insert-behind))
-
-;; We have to fake our way around atomicity.
-
-;; Here is the beef: for best intuitiveness, we want to have
-;; insertions be carried out as expected before iconized text
-;; passages, but we want to insert *into* the overlay when not
-;; iconized.  A preview that has become empty can not get content
-;; again: we remove it.  A disabled preview needs no insert-in-front
-;; handler.
-
-(defvar preview-change-list nil
-  "List of tentatively changed overlays.")
-
-(defcustom preview-dump-threshold
-  "^ *\\\\begin *{document}[ %]*$"
-  "*Regexp denoting end of preamble.
-This is the location up to which preamble changes are considered
-to require redumping of a format."
-  :group 'preview-latex
-  :type 'string)
-
-(defun preview-preamble-changed-function
-  (ov after-change beg end &optional length)
-  "Hook function for change hooks on preamble.
-See info node `(elisp) Overlay Properties' for
-definition of OV, AFTER-CHANGE, BEG, END and LENGTH."
-  (let ((format-cons (overlay-get ov 'format-cons)))
-    (preview-unwatch-preamble format-cons)
-    (preview-format-kill format-cons)
-    (setcdr format-cons t)))
-
-(defun preview-watch-preamble (file command format-cons)
-  "Set up a watch on master file FILE.
-FILE can be an associated buffer instead of a filename.
-COMMAND is the command that generated the format.
-FORMAT-CONS contains the format info for the main
-format dump handler."
-  (let ((buffer (if (bufferp file)
-                   file
-                 (find-buffer-visiting file))) ov)
-    (setcdr
-     format-cons
-     (cons command
-          (when buffer
-            (with-current-buffer buffer
-              (save-excursion
-                (save-restriction
-                  (widen)
-                  (goto-char (point-min))
-                  (unless (re-search-forward preview-dump-threshold nil t)
-                    (error "Can't find preamble of `%s'" file))
-                  (setq ov (make-overlay (point-min) (point)))
-                  (overlay-put ov 'format-cons format-cons)
-                  (overlay-put ov 'insert-in-front-hooks
-                               '(preview-preamble-changed-function))
-                  (overlay-put ov 'modification-hooks
-                               '(preview-preamble-changed-function))
-                  ov))))))))
-
-(defun preview-unwatch-preamble (format-cons)
-  "Stop watching a format on FORMAT-CONS.
-The watch has been set up by `preview-watch-preamble'."
-  (when (consp (cdr format-cons))
-    (when (cddr format-cons)
-      (delete-overlay (cddr format-cons)))
-    (setcdr (cdr format-cons) nil)))
-
-(defun preview-register-change (ov)
-  "Register not yet changed OV for verification.
-This stores the old contents of the overlay in the
-`preview-prechange' property and puts the overlay into
-`preview-change-list' where `preview-check-changes' will
-find it at some later point of time."
-  (unless (overlay-get ov 'preview-prechange)
-    (if (eq (overlay-get ov 'preview-state) 'disabled)
-       (overlay-put ov 'preview-prechange t)
-      (overlay-put ov 'preview-prechange
-                  (save-restriction
-                    (widen)
-                    (buffer-substring-no-properties
-                     (overlay-start ov) (overlay-end ov)))))
-    (push ov preview-change-list)))
-
-(defun preview-check-changes ()
-  "Check whether the contents under the overlay have changed.
-Disable it if that is the case.  Ignores text properties."
-  (dolist (ov preview-change-list)
-    (condition-case nil
-       (with-current-buffer (overlay-buffer ov)
-         (let ((text (save-restriction
-                       (widen)
-                       (buffer-substring-no-properties
-                        (overlay-start ov) (overlay-end ov)))))
-           (if (zerop (length text))
-               (preview-delete ov)
-             (unless
-                 (or (eq (overlay-get ov 'preview-state) 'disabled)
-                     (preview-relaxed-string=
-                      text (overlay-get ov 'preview-prechange)))
-               (overlay-put ov 'insert-in-front-hooks nil)
-               (overlay-put ov 'insert-behind-hooks nil)
-               (preview-disable ov)))))
-      (error nil))
-    (overlay-put ov 'preview-prechange nil))
-  (setq preview-change-list nil))
-
-(defun preview-handle-insert-in-front
-  (ov after-change beg end &optional length)
-  "Hook function for `insert-in-front-hooks' property.
-See info node `(elisp) Overlay Properties' for
-definition of OV, AFTER-CHANGE, BEG, END and LENGTH."
-  (if after-change
-      (unless undo-in-progress
-       (if (eq (overlay-get ov 'preview-state) 'active)
-           (move-overlay ov end (overlay-end ov))))
-    (preview-register-change ov)))
-
-(defun preview-handle-insert-behind
-  (ov after-change beg end &optional length)
-  "Hook function for `insert-behind-hooks' property.
-This is needed in case `insert-before-markers' is used at the
-end of the overlay.  See info node `(elisp) Overlay Properties'
-for definition of OV, AFTER-CHANGE, BEG, END and LENGTH."
-  (if after-change
-      (unless undo-in-progress
-       (if (eq (overlay-get ov 'preview-state) 'active)
-           (move-overlay ov (overlay-start ov) beg)))
-    (preview-register-change ov)))
-
-(defun preview-handle-modification
-  (ov after-change beg end &optional length)
-  "Hook function for `modification-hooks' property.
-See info node `(elisp) Overlay Properties' for
-definition of OV, AFTER-CHANGE, BEG, END and LENGTH."
-  (unless after-change
-    (preview-register-change ov)))
-
-(defun preview-toggle (ov &optional arg event)
-  "Toggle visibility of preview overlay OV.
-ARG can be one of the following: t displays the overlay,
-nil displays the underlying text, and 'toggle toggles.
-If EVENT is given, it indicates the window where the event
-occured, either by being a mouse event or by directly being
-the window in question.  This may be used for cursor restoration
-purposes."
-  (let ((old-urgent (preview-remove-urgentization ov))
-       (preview-state
-        (if (if (eq arg 'toggle)
-                (null (eq (overlay-get ov 'preview-state) 'active))
-              arg)
-            'active
-          'inactive))
-       (strings (overlay-get ov 'strings)))
-    (unless (eq (overlay-get ov 'preview-state) 'disabled)
-      (overlay-put ov 'preview-state preview-state)
-      (if (eq preview-state 'active)
-         (progn
-           (overlay-put ov 'category 'preview-overlay)
-           (if (eq (overlay-start ov) (overlay-end ov))
-               (overlay-put ov 'before-string (car strings))
-             (dolist (prop '(display keymap mouse-face help-echo))
-               (overlay-put ov prop
-                            (get-text-property 0 prop (car strings))))
-             (overlay-put ov 'before-string nil))
-           (overlay-put ov 'face nil))
-       (dolist (prop '(display keymap mouse-face help-echo))
-         (overlay-put ov prop nil))
-       (overlay-put ov 'face 'preview-face)
-       (unless (cdr strings)
-         (setcdr strings (preview-inactive-string ov)))
-       (overlay-put ov 'before-string (cdr strings)))
-      (if old-urgent
-         (apply 'preview-add-urgentization old-urgent))))
-  (if event
-      (preview-restore-position
-       ov
-       (if (windowp event)
-          event
-        (posn-window (event-start event))))))
-
-(defun preview-mode-setup ()
-  "Setup proper buffer hooks and behavior for previews."
-  (set (make-local-variable 'desktop-save-buffer)
-       #'desktop-buffer-preview-misc-data)
-  (add-hook 'pre-command-hook #'preview-mark-point nil t)
-  (add-hook 'post-command-hook #'preview-move-point nil t)
-  (easy-menu-add preview-menu LaTeX-mode-map)
-  (unless preview-tb-icon
-    (setq preview-tb-icon (preview-filter-specs preview-tb-icon-specs)))
-  (when preview-tb-icon
-    (define-key LaTeX-mode-map [tool-bar preview]
-      `(menu-item "Preview at point" preview-at-point
-                 :image ,preview-tb-icon
-                 :help "Preview on/off at point")))
-  (when buffer-file-name
-    (let* ((filename (expand-file-name buffer-file-name))
-          format-cons)
-      (when (string-match (concat "\\." TeX-default-extension "\\'")
-                         filename)
-       (setq filename (substring filename 0 (match-beginning 0))))
-      (setq format-cons (assoc filename preview-dumped-alist))
-      (when (consp (cdr format-cons))
-       (preview-unwatch-preamble format-cons)
-       (preview-watch-preamble (current-buffer)
-                               (cadr format-cons)
-                               format-cons)))))
-
-(defvar preview-marker (make-marker)
-  "Marker for fake intangibility.")
-
-(defvar preview-temporary-opened nil)
-
-(defvar preview-last-location nil
-  "Restored cursor position marker for reopened previews.")
-(make-variable-buffer-local 'preview-last-location)
-
-(defun preview-mark-point ()
-  "Mark position for fake intangibility."
-  (when (eq (get-char-property (point) 'preview-state) 'active)
-    (unless preview-last-location
-      (setq preview-last-location (make-marker)))
-    (set-marker preview-last-location (point))
-    (set-marker preview-marker (point))
-    (preview-move-point))
-  (set-marker preview-marker (point)))
-
-(defun preview-restore-position (ov window)
-  "Tweak position after opening/closing preview.
-The treated overlay OV has been triggered in WINDOW.  This function
-records the original buffer position for reopening, or restores it
-after reopening.  Note that by using the mouse, you can open/close
-overlays not in the active window."
-  (when (eq (overlay-buffer ov) (window-buffer window))
-    (with-current-buffer (overlay-buffer ov)
-      (if (eq (overlay-get ov 'preview-state) 'active)
-         (setq preview-last-location
-               (set-marker (or preview-last-location (make-marker))
-                           (window-point window)))
-       (when (and
-              (markerp preview-last-location)
-              (eq (overlay-buffer ov) (marker-buffer preview-last-location))
-              (< (overlay-start ov) preview-last-location)
-              (> (overlay-end ov) preview-last-location))
-         (set-window-point window preview-last-location))))))
-      
-(defun preview-move-point ()
-  "Move point out of fake-intangible areas."
-  (preview-check-changes)
-  (let* (newlist (pt (point)) (lst (overlays-at pt)) distance)
-    (setq preview-temporary-opened
-         (dolist (ov preview-temporary-opened newlist)
-           (and (overlay-buffer ov)
-                (eq (overlay-get ov 'preview-state) 'inactive)
-                (if (and (eq (overlay-buffer ov) (current-buffer))
-                         (or (<= pt (overlay-start ov))
-                             (>= pt (overlay-end ov))))
-                    (preview-toggle ov t)
-                  (push ov newlist)))))
-    (when lst
-      (if (or disable-point-adjustment
-             global-disable-point-adjustment
-             (preview-auto-reveal-p
-              preview-auto-reveal
-              (setq distance
-                    (and (eq (marker-buffer preview-marker)
-                             (current-buffer))
-                         (- pt (marker-position preview-marker))))))
-         (preview-open-overlays lst)
-       (while lst
-         (setq lst
-               (if (and
-                    (eq (overlay-get (car lst) 'preview-state) 'active)
-                    (> pt (overlay-start (car lst))))
-                   (overlays-at
-                    (setq pt (if (and distance (< distance 0))
-                                 (overlay-start (car lst))
-                               (overlay-end (car lst)))))
-                 (cdr lst))))
-       (goto-char pt)))))
-
-(defun preview-open-overlays (list &optional pos)
-  "Open all previews in LIST, optionally restricted to enclosing POS."
-  (dolist (ovr list)
-    (when (and (eq (overlay-get ovr 'preview-state) 'active)
-              (or (null pos)
-                  (and
-                   (> pos (overlay-start ovr))
-                   (< pos (overlay-end ovr)))))
-      (preview-toggle ovr)
-      (push ovr preview-temporary-opened))))
-
-(defadvice replace-highlight (before preview)
-  "Make `query-replace' open preview text about to be replaced."
-  (preview-open-overlays
-   (overlays-in (ad-get-arg 0) (ad-get-arg 1))))
-
-(defcustom preview-query-replace-reveal t
-  "*Make `query-replace' autoreveal previews."
-  :group 'preview-appearance
-  :type 'boolean
-  :require 'preview
-  :set (lambda (symbol value)
-        (set-default symbol value)
-        (if value
-            (ad-enable-advice 'replace-highlight 'before 'preview)
-          (ad-disable-advice 'replace-highlight 'before 'preview))
-        (ad-activate 'replace-highlight))
-  :initialize #'custom-initialize-reset)
-
-;; Check whether the four-argument form of `face-attribute' exists.
-;; If not, we will get a `wrong-number-of-arguments' error thrown.
-;; Use `defun' instead of `defsubst' here so that the decision may be
-;; reverted at load time if you are compiling with one Emacs and using
-;; another.
-(if (condition-case nil
-       (progn
-         (face-attribute 'default :height nil nil)
-         t)
-      (wrong-number-of-arguments nil))
-
-    (defun preview-inherited-face-attribute (face attribute &optional inherit)
-      "Fetch face attribute while adhering to inheritance.
-This searches FACE for an ATTRIBUTE, using INHERIT
-for resolving unspecified or relative specs.  See the fourth
-argument of function `face-attribute' for details."
-      (face-attribute face attribute nil inherit))
-
-  (defun preview-inherited-face-attribute (face attribute &optional inherit)
-    "Fetch face attribute while adhering to inheritance.
-This searches FACE for an ATTRIBUTE.  If it is 'unspecified,
-first inheritance is consulted (if INHERIT is non-NIL), then
-INHERIT is searched if it is a face or a list of faces.
-Relative specs are evaluated recursively until they get absolute or
-are not resolvable.  Relative specs are float values."
-    (let ((value (face-attribute face attribute)))
-      (when inherit
-       (setq inherit
-             (append
-              (let ((ancestors (face-attribute face :inherit)))
-                (cond ((facep ancestors) (list ancestors))
-                      ((consp ancestors) ancestors)))
-              (cond ((facep inherit) (list inherit))
-                    ((consp inherit) inherit)))))
-      (cond ((null inherit) value)
-           ((floatp value)
-            (let ((avalue
-                   (preview-inherited-face-attribute
-                    (car inherit) attribute (or (cdr inherit) t))))
-              (cond ((integerp avalue)
-                     (round (* avalue value)))
-                    ((floatp avalue)
-                     (* value avalue))
-                    (t value))))
-           ((eq value 'unspecified)
-            (preview-inherited-face-attribute
-             (car inherit) attribute (or (cdr inherit) t)))
-           (t value)))))
-
-(defun preview-get-colors ()
-  "Return colors from the current display.
-Fetches the current screen colors and makes a vector
-of colors as numbers in the range 0..65535.
-Pure borderless black-on-white will return triple NIL.
-The fourth value is the transparent border thickness."
-  (let
-      ((bg (color-values (preview-inherited-face-attribute
-                         'preview-reference-face :background 'default)))
-       (fg (color-values (preview-inherited-face-attribute
-                         'preview-reference-face :foreground 'default)))
-       (mask (preview-get-heuristic-mask)))
-    (if (equal '(65535 65535 65535) bg)
-       (setq bg nil))
-    (if (equal '(0 0 0) fg)
-       (setq fg nil))
-    (unless (and (numberp preview-transparent-border)
-                (consp mask) (integerp (car mask)))
-      (setq mask nil))
-    (vector bg fg mask preview-transparent-border)))
-
-(defun preview-import-image (image)
-  "Convert the printable IMAGE rendition back to an image."
-  (cond ((stringp image)
-        (propertize image 'face 'preview-face))
-       ((eq (car image) 'image)
-        image)
-       (t
-        (preview-create-icon-1 (nth 0 image)
-                               (nth 1 image)
-                               (nth 2 image)
-                               (if (< (length image) 4)
-                                   (preview-get-heuristic-mask)
-                                 (nth 3 image))))))
-
-(defsubst preview-supports-image-type (imagetype)
-  "Check if IMAGETYPE is supported."
-  (image-type-available-p imagetype))
-
-(provide 'prv-emacs)
-;;; prv-emacs.el ends here



reply via email to

[Prev in Thread] Current Thread [Next in Thread]