[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[AUCTeX-diffs] GNU AUCTeX branch, master, updated. b21889e0f805ddaaea253
|
From: |
Ikumi Keita |
|
Subject: |
[AUCTeX-diffs] GNU AUCTeX branch, master, updated. b21889e0f805ddaaea25317da2c872d90907d0c2 |
|
Date: |
Fri, 24 Jul 2020 03:06:37 -0400 (EDT) |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU AUCTeX".
The branch, master has been updated
via b21889e0f805ddaaea25317da2c872d90907d0c2 (commit)
from 67ecb0bc3be90a8be08eaf001b63538cb57f3294 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit b21889e0f805ddaaea25317da2c872d90907d0c2
Author: Ikumi Keita <ikumi@ikumi.que.jp>
Date: Fri Jul 24 16:02:05 2020 +0900
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.
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
-----------------------------------------------------------------------
Summary of changes:
Makefile.in | 2 +-
configure.ac | 3 -
preview.el.in | 512 +++++++++++++++++++++++++++++++++++++++++++++++-
prv-emacs.el | 609 ----------------------------------------------------------
4 files changed, 511 insertions(+), 615 deletions(-)
delete mode 100644 prv-emacs.el
hooks/post-receive
--
GNU AUCTeX
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [AUCTeX-diffs] GNU AUCTeX branch, master, updated. b21889e0f805ddaaea25317da2c872d90907d0c2,
Ikumi Keita <=