Archived
1
0
Fork 0
This repository has been archived on 2024-10-19. You can view files and clone it, but cannot push or open issues or pull requests.
emacs/code/elpa/auctex-13.2.1/preview.el

4297 lines
178 KiB
EmacsLisp
Raw Permalink Normal View History

2022-08-25 17:42:37 +00:00
;;; preview.el --- embed preview LaTeX images in source buffer -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2022 Free Software Foundation, Inc.
;; Author: David Kastrup
;; Keywords: tex, wp, convenience
;; 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:
;; This style is for the "seamless" embedding of generated images
;; into LaTeX source code. Please see the README and INSTALL files
;; for further instruction.
;;
;; Please use the usual configure script for installation: more than
;; just Elisp files are involved: a LaTeX style, icon files, startup
;; code and so on.
;;
;; Quite a few things with regard to preview-latex's operation can be
;; configured by using
;; M-x customize-group RET preview RET
;;
;; Please report bugs with M-x preview-report-bug RET.
;;; Code:
(require 'tex-site)
(require 'tex)
(require 'latex)
(eval-when-compile
(condition-case nil
(require 'desktop)
(file-error (message "Missing desktop package:
preview-latex buffers will not survive across sessions.")))
(condition-case nil
(require 'reporter)
(file-error (message "Missing reporter library, probably from the mail-lib package:
preview-latex's bug reporting commands will probably not work.")))
(require 'info))
(defgroup preview nil "Embed Preview images into LaTeX buffers."
:group 'AUCTeX
:prefix "preview-"
:link '(custom-manual "(preview-latex)Top")
:link '(info-link "(preview-latex)The Emacs interface")
:link '(url-link :tag "Homepage" "https://www.gnu.org/software/auctex/"))
(defgroup preview-gs nil "Preview's Ghostscript renderer."
:group 'preview
:prefix "preview-")
(defgroup preview-appearance nil "Preview image appearance."
:group 'preview
:prefix "preview-")
(defconst preview-specs-type
'(repeat
(list :tag "Image spec"
;; Use an extra :value keyword to avoid a bug in
;; `widget-convert' of XEmacs 21.4 and Emacs 21.
;; Analogously for the following `const' statements.
(const :format "" :value :type)
(choice :tag "Image type"
(const xpm)
(const xbm)
(symbol :tag "Other"))
(set :inline t :tag "Minimum font size"
(list :inline t :tag ""
(const :format "" :value :min)
(integer :tag "pixels")))
(const :format "" :value :file) (string :tag "Filename")
(set :inline t :tag "Ascent ratio"
(list :inline t :tag ""
(const :format "" :value :ascent)
(integer :tag "percent of image"
:value 50))))))
(defun preview-specs-setter (symbol value)
"Set SYMBOL to VALUE and clear `preview-min-alist' property.
This is used in icon specs, so that customizing will
clear cached icons."
(put symbol 'preview-min-alist nil)
(set-default symbol value))
(defcustom preview-nonready-icon-specs
'((:type xpm :min 26 :file "prvwrk24.xpm" :ascent 90)
(:type xpm :min 22 :file "prvwrk20.xpm" :ascent 90)
(:type xpm :min 17 :file "prvwrk16.xpm" :ascent 90)
(:type xpm :min 15 :file "prvwrk14.xpm" :ascent 90)
(:type xpm :file "prvwrk12.xpm" :ascent 90)
(:type xbm :file "prvwrk24.xbm" :ascent 90))
"The icon used for previews to be generated.
The spec must begin with `:type'. File names are relative to
`load-path' and `data-directory', a spec `:min' requires a
minimal pixel height for `preview-reference-face' before the spec
will be considered. Since evaluating the `:file' spec takes
considerable time under XEmacs, it should come after the `:min'
spec to avoid unnecessary evaluation time."
:group 'preview-appearance
:type preview-specs-type
:set #'preview-specs-setter)
(defvar preview-nonready-icon nil
"The icon used for previews to be generated.
Suitable spec is chosen from `preview-nonready-icon-specs'.")
(defcustom preview-error-icon-specs
'((:type xpm :min 22 :file "prverr24.xpm" :ascent 90)
(:type xpm :min 18 :file "prverr20.xpm" :ascent 90)
(:type xpm :file "prverr16.xpm" :ascent 90)
(:type xbm :file "prverr24.xbm" :ascent 90))
"The icon used for PostScript errors.
The spec must begin with `:type'. File names are relative to
`load-path' and `data-directory', a spec `:min' requires a
minimal pixel height for `preview-reference-face' before the spec
will be considered. Since evaluating the `:file' spec takes
considerable time under XEmacs, it should come after the `:min'
spec to avoid unnecessary evaluation time."
:group 'preview-appearance
:type preview-specs-type
:set #'preview-specs-setter
)
(defvar preview-error-icon nil
"The icon used for PostScript errors.
Suitable spec is chosen from `preview-error-icon-specs'.")
(defcustom preview-icon-specs
'((:type xpm :min 24 :file "prvtex24.xpm" :ascent 75)
(:type xpm :min 20 :file "prvtex20.xpm" :ascent 75)
(:type xpm :min 16 :file "prvtex16.xpm" :ascent 75)
(:type xpm :file "prvtex12.xpm" :ascent 75)
(:type xbm :min 24 :file "prvtex24.xbm" :ascent 75)
(:type xbm :min 16 :file "prvtex16.xbm" :ascent 75)
(:type xbm :file "prvtex12.xbm" :ascent 75))
"The icon used for an open preview.
The spec must begin with `:type'. File names are relative to
`load-path' and `data-directory', a spec `:min' requires a
minimal pixel height for `preview-reference-face' before the spec
will be considered. Since evaluating the `:file' spec takes
considerable time under XEmacs, it should come after the `:min'
spec to avoid unnecessary evaluation time."
:group 'preview-appearance
:type preview-specs-type
:set #'preview-specs-setter)
(defvar preview-icon nil
"The icon used for an open preview.
Suitable spec is chosen from `preview-icon-specs'.")
(defgroup preview-latex nil "LaTeX options for preview."
:group 'preview
:prefix "preview-")
(defcustom preview-image-creators
'((dvipng
(open preview-gs-open preview-dvipng-process-setup)
(place preview-gs-place)
(close preview-dvipng-close))
(png (open preview-gs-open)
(place preview-gs-place)
(close preview-gs-close))
(jpeg (open preview-gs-open)
(place preview-gs-place)
(close preview-gs-close))
(pnm (open preview-gs-open)
(place preview-gs-place)
(close preview-gs-close))
(tiff (open preview-gs-open)
(place preview-gs-place)
(close preview-gs-close)))
"Define functions for generating images.
These functions get called in the process of generating inline
images of the specified type. The open function is called
at the start of a rendering pass, the place function for
placing every image, the close function at the end of
the pass. Look at the documentation of the various
functions used here for the default settings, and at
the function `preview-call-hook' through which those are
called. Additional argument lists specified in here
are passed to the functions before any additional
arguments given to `preview-call-hook'.
Not all of these image types may be supported by your copy
of Ghostscript, or by your copy of Emacs."
:group 'preview-gs
:type '(alist :key-type (symbol :tag "Preview's image type")
:value-type
(alist :tag "Handler" :key-type (symbol :tag "Operation:")
:value-type (list :tag "Handler"
(function :tag "Handler function")
(repeat :tag "Additional \
function args" :inline t sexp))
:options (open place close))))
(defcustom preview-gs-image-type-alist
'((png png "-sDEVICE=png16m")
(dvipng png "-sDEVICE=png16m")
(jpeg jpeg "-sDEVICE=jpeg")
(pnm pbm "-sDEVICE=pnmraw")
(tiff tiff "-sDEVICE=tiff12nc"))
"Alist of image types and corresponding Ghostscript options.
The `dvipng' and `postscript' (don't use) entries really specify
a fallback device when images can't be processed by the requested
method, like when PDFTeX was used."
:group 'preview-gs
:type '(repeat (list :tag nil (symbol :tag "preview image-type")
(symbol :tag "Emacs image-type")
(repeat :inline t :tag "Ghostscript options" string))))
(defcustom preview-image-type 'png
"Image type to be used in images."
:group 'preview-gs
:type (append '(choice)
(mapcar (lambda (symbol) (list 'const (car symbol)))
preview-image-creators)
'((symbol :tag "Other"))))
(defun preview-call-hook (symbol &rest rest)
"Call a function from `preview-image-creators'.
This looks up SYMBOL in the `preview-image-creators' entry
for the image type `preview-image-type' and calls the
hook function given there with the arguments specified there
followed by REST. If such a function is specified in there,
that is."
(let ((hook (cdr (assq symbol
(cdr (assq preview-image-type
preview-image-creators))))))
(when hook
(apply (car hook) (append (cdr hook) rest)))))
(defvar TeX-active-tempdir nil
"List of directory name, top directory name and reference count.")
(make-variable-buffer-local 'TeX-active-tempdir)
(defcustom preview-bb-filesize 1024
"Size of file area scanned for bounding box information."
:group 'preview-gs :type 'integer)
(defcustom preview-preserve-indentation t
"Whether to keep additional whitespace at the left of a line."
:group 'preview-appearance :type 'boolean)
(defun preview-extract-bb (filename)
"Extract EPS bounding box vector from FILENAME."
(with-temp-buffer
(insert-file-contents-literally filename nil 0 preview-bb-filesize
t)
(goto-char (point-min))
(when (search-forward-regexp "%%BoundingBox:\
+\\([-+]?[0-9.]+\\)\
+\\([-+]?[0-9.]+\\)\
+\\([-+]?[0-9.]+\\)\
+\\([-+]?[0-9.]+\\)" nil t)
(vector
(if preview-preserve-indentation
(min 72 (string-to-number (match-string 1)))
(string-to-number (match-string 1)))
(string-to-number (match-string 2))
(string-to-number (match-string 3))
(string-to-number (match-string 4))
))))
(defcustom preview-prefer-TeX-bb nil
"Prefer TeX bounding box to EPS one if available.
If `preview-fast-conversion' is set, this option is not
consulted since the TeX bounding box has to be used anyway."
:group 'preview-gs
:type 'boolean)
(defcustom preview-TeX-bb-border 0.5
"Additional space in pt around Bounding Box from TeX."
:group 'preview-gs
:type 'number)
(defvar preview-parsed-font-size nil
"Font size as parsed from the log of LaTeX run.")
(make-variable-buffer-local 'preview-parsed-font-size)
(defvar preview-parsed-magnification nil
"Magnification as parsed from the log of LaTeX run.")
(make-variable-buffer-local 'preview-parsed-magnification)
(defvar preview-parsed-pdfoutput nil
"PDFoutput as parsed from the log of LaTeX run.")
(make-variable-buffer-local 'preview-parsed-pdfoutput)
(defvar preview-parsed-counters nil
"Counters as parsed from the log of LaTeX run.")
(make-variable-buffer-local 'preview-parsed-counters)
(defvar preview-parsed-tightpage nil
"Tightpage as parsed from the log of LaTeX run.")
(make-variable-buffer-local 'preview-parsed-tightpage)
(defun preview-get-magnification ()
"Get magnification from `preview-parsed-magnification'."
(if preview-parsed-magnification
(/ preview-parsed-magnification 1000.0) 1.0))
(defun preview-TeX-bb (list)
"Calculate bounding box from (ht dp wd).
LIST consists of TeX dimensions in sp (1/65536 TeX point)."
(and
(consp list)
(let* ((dims (vconcat (mapcar
#'(lambda (x)
(/ x 65781.76))
list)))
(box
(vector
(+ 72 (min 0 (aref dims 2)))
(+ 720 (min (aref dims 0) (- (aref dims 1)) 0))
(+ 72 (max 0 (aref dims 2)))
(+ 720 (max (aref dims 0) (- (aref dims 1)) 0))))
(border (if preview-parsed-tightpage
(vconcat (mapcar
#'(lambda(x)
(/ x 65781.76))
preview-parsed-tightpage))
(vector (- preview-TeX-bb-border)
(- preview-TeX-bb-border)
preview-TeX-bb-border
preview-TeX-bb-border))))
(dotimes (i 4)
(aset box i (+ (aref box i) (aref border i))))
box)))
(defcustom preview-gs-command
(or ;; The GS wrapper coming with TeX Live
(executable-find "rungs")
;; The MikTeX builtin GS
(let ((gs (executable-find "mgs")))
;; Check if mgs is functional for external non-MikTeX apps.
;; See http://blog.miktex.org/post/2005/04/07/Starting-mgsexe-at-the-DOS-Prompt.aspx
(when (and gs (= 0 (shell-command (concat (shell-quote-argument gs) " -q -dNODISPLAY -c quit"))))
gs))
;; Windows ghostscript
(executable-find "GSWIN32C.EXE")
;; standard GhostScript
(executable-find "gs"))
"How to call gs for conversion from EPS. See also `preview-gs-options'."
:group 'preview-gs
:type 'string)
(defcustom preview-gs-options '("-q" "-dDELAYSAFER" "-dNOPAUSE"
"-DNOPLATFONTS" "-dPrinted"
"-dTextAlphaBits=4"
"-dGraphicsAlphaBits=4")
"Options with which to call gs for conversion from EPS.
See also `preview-gs-command'."
:group 'preview-gs
:type '(repeat string))
(defvar preview-gs-queue nil
"List of overlays to convert using gs.
Buffer-local to the appropriate TeX process buffer.")
(make-variable-buffer-local 'preview-gs-queue)
(defvar preview-gs-outstanding nil
"Overlays currently processed.")
(make-variable-buffer-local 'preview-gs-outstanding)
(defcustom preview-gs-outstanding-limit 2
"Number of requests allowed to be outstanding.
This is the number of not-yet-completed requests we
might at any time have piped into Ghostscript. If
this number is larger, the probability of Ghostscript
working continuously is higher when Emacs is rather
busy. If this number is smaller, redisplay will
follow changes in the displayed buffer area faster."
:group 'preview-gs
:type '(restricted-sexp
:match-alternatives
((lambda (value) (and
(integerp value)
(> value 0)
(< value 10))))
:tag "small number"))
(defvar preview-gs-answer nil
"Accumulated answer of Ghostscript process.")
(make-variable-buffer-local 'preview-gs-answer)
(defvar preview-gs-image-type nil
"Image type for gs produced images.")
(make-variable-buffer-local 'preview-gs-image-type)
(defvar preview-gs-sequence nil
"Pair of sequence numbers for gs produced images.")
(make-variable-buffer-local 'preview-gs-sequence)
(defvar preview-scale nil
"Screen scale of images.
Magnify by this factor to make images blend with other
screen content. Buffer-local to rendering buffer.")
(make-variable-buffer-local 'preview-scale)
(defvar preview-colors nil
"Color setup list.
An array with elements 0, 1 and 2 for background,
foreground and border colors, respectively. Each element
is a list of 3 real numbers between 0 and 1, or nil
of nothing special should be done for the color")
(make-variable-buffer-local 'preview-colors)
(defvar preview-gs-init-string nil
"Ghostscript setup string.")
(make-variable-buffer-local 'preview-gs-init-string)
(defvar preview-ps-file nil
"PostScript file name for fast conversion.")
(make-variable-buffer-local 'preview-ps-file)
(defvar preview-gs-dsc nil
"Parsed DSC information.")
(make-variable-buffer-local 'preview-gs-dsc)
(defvar preview-resolution nil
"Screen resolution where rendering started.
Cons-cell of x and y resolution, given in
dots per inch. Buffer-local to rendering buffer.")
(make-variable-buffer-local 'preview-resolution)
(defun preview-gs-resolution (scale xres yres)
"Generate resolution argument for gs.
Calculated from real-life factor SCALE and XRES and
YRES, the screen resolution in dpi."
(format "-r%gx%g"
(/ (* scale xres) (preview-get-magnification))
(/ (* scale yres) (preview-get-magnification))))
(defun preview-gs-behead-outstanding (err)
"Remove leading element of outstanding queue after error.
Return element if non-nil. ERR is the error string to
show as response of Ghostscript."
(let ((ov (pop preview-gs-outstanding)))
(when ov
(preview-gs-flag-error ov err)
(overlay-put ov 'queued nil))
ov))
(defvar preview-gs-command-line nil)
(make-variable-buffer-local 'preview-gs-command-line)
(defvar preview-gs-file nil)
(make-variable-buffer-local 'preview-gs-file)
(defcustom preview-fast-conversion t
"Set this for single-file PostScript conversion.
This will have no effect when `preview-image-type' is
set to `postscript'."
:group 'preview-latex
:type 'boolean)
(defun preview-string-expand (arg &optional separator)
"Expand ARG as a string.
It can already be a string. Or it can be a list, then it is
recursively evaluated using SEPARATOR as separator. If a list
element is in itself a CONS cell, the CAR of the list (after symbol
dereferencing) can evaluate to either a string, in which case it is
used as a separator for the rest of the list,
or a boolean (t or nil) in which case the rest of the list is
either evaluated and concatenated or ignored, respectively.
ARG can be a symbol, and so can be the CDR
of a cell used for string concatenation."
(cond
((stringp arg) arg)
((consp arg)
(mapconcat
#'identity
(delq nil
(mapcar
(lambda(x)
(if (consp x)
(let ((sep (car x)))
(while (and (symbolp sep)
(not (memq sep '(t nil))))
(setq sep (symbol-value sep)))
(if (stringp sep)
(preview-string-expand (cdr x) sep)
(and sep
(preview-string-expand (cdr x)))))
(preview-string-expand x)))
arg))
(or separator "")))
((and (symbolp arg) (not (memq arg '(t nil))))
(preview-string-expand (symbol-value arg) separator))
(t (error "Bad string expansion"))))
(defconst preview-expandable-string
(let ((f (lambda (x)
`(choice
string
(repeat :tag "Concatenate"
(choice
string
(cons :tag "Separated list"
(choice (string :tag "Separator")
(symbol :tag
"Indirect separator or flag"))
,x)
(symbol :tag "Indirect variable (no separator)")))
(symbol :tag "Indirect variable (with separator)")))))
(funcall f (funcall f 'sexp)))
"Type to be used for `preview-string-expand'.
Just a hack until we get to learn how to do this properly.
Recursive definitions are not popular with Emacs,
so we define this type just two levels deep. This
kind of expandible string can either be just a string, or a
cons cell with a separator string in the CAR, and either
an explicit list of elements in the CDR, or a symbol to
be consulted recursively.")
(defcustom preview-dvipng-command
"dvipng -picky -noghostscript %d -o %m/prev%%03d.png"
"Command used for converting to separate PNG images.
You might specify options for converting to other image types,
but then you'll need to adapt `preview-dvipng-image-type'."
:group 'preview-latex
:type 'string)
(defcustom preview-dvipng-image-type
'png
"Image type that dvipng produces.
You'll need to change `preview-dvipng-command' too,
if you customize this."
:group 'preview-latex
:type '(choice (const png)
(const gif)
(symbol :tag "Other" :value png)))
(defcustom preview-dvips-command
"dvips -Pwww -i -E %d -o %m/preview.000"
"Command used for converting to separate EPS images."
:group 'preview-latex
:type 'string)
(defcustom preview-fast-dvips-command
"dvips -Pwww %d -o %m/preview.ps"
"Command used for converting to a single PS file."
:group 'preview-latex
:type 'string)
(defcustom preview-pdf2dsc-command
"pdf2dsc %(O?pdf) %m/preview.dsc"
"Command used for generating dsc from a PDF file."
:group 'preview-latex
:type 'string)
(defun preview-gs-queue-empty ()
"Kill off everything remaining in `preview-gs-queue'."
(mapc #'preview-delete preview-gs-outstanding)
(dolist (ov preview-gs-queue)
(if (overlay-get ov 'queued)
(preview-delete ov)))
(setq preview-gs-outstanding nil)
(setq preview-gs-queue nil))
(defvar preview-error-condition nil
"Last error raised and to be reported.")
(defun preview-log-error (err context &optional process)
"Log an error message to run buffer.
ERR is the caught error syndrome, CONTEXT is where it
occured, PROCESS is the process for which the run-buffer
is to be used."
(when (or (null process) (buffer-name (process-buffer process)))
(with-current-buffer (or (and process
(process-buffer process))
(current-buffer))
(save-excursion
(goto-char (or (and process
(process-buffer process)
(marker-buffer (process-mark process))
(process-mark process))
(point-max)))
(insert-before-markers
(format "%s: %s\n"
context (error-message-string err)))
(display-buffer (current-buffer)))))
(setq preview-error-condition err))
(defun preview-reraise-error (&optional process)
"Raise an error that has been logged.
Makes sure that PROCESS is removed from the \"Compilation\"
tag in the mode line."
(when preview-error-condition
(unwind-protect
(signal (car preview-error-condition) (cdr preview-error-condition))
(setq preview-error-condition nil
compilation-in-progress (delq process compilation-in-progress)))))
(defcustom preview-pdf-color-adjust-method t
"Method to adjust colors of images generated from PDF.
It is not consulted when the latex command produces DVI files.
The valid values are:
t: preview-latex transfers the foreground and background colors
of Emacs to the generated images. This option requires that
Ghostscript has working DELAYBIND feature, thus is invalid with
gs 9.27 (and possibly < 9.27).
`compatible': preview-latex uses another mothod to transfer
colors. This option is provided for compatibility with older gs.
See the below explanation for detail.
nil: no adjustment is done and \"black on white\" image is
generated regardless of Emacs color. This is provided for fallback for
gs 9.27 users with customized foreground color. See the below
explanation for detail.
When the latex command produces PDF rather than DVI and Emacs has
non-trivial foreground color, the traditional method (`compatible')
makes gs >= 9.27 to stop with error. Here, \"non-trivial foreground
color\" includes customized themes.
If you use such non-trivial foreground color and the version of
Ghostscript equals to 9.27, you have two options:
- Choose the value `compatible' and customize
`preview-reference-face' to have default (black) foreground
color. This makes the generated image almost non-readable on
dark background, so the next option would be your only choice in
that case.
- Choose the value nil, which forces plain \"black on white\"
appearance for the generated image. You can at least read what
are written in the image although they may not match with your
Emacs color well."
:group 'preview-appearance
:type '(choice
(const :tag "Adjust to Emacs color (gs > 9.27)" t)
(const :tag "Compatibility for gs =< 9.27" compatible)
(const :tag "No adjustment (B/W, for gs 9.27)" nil)))
(defun preview-gs-sentinel (process string)
"Sentinel function for rendering process.
Gets the default PROCESS and STRING arguments
and tries to restart Ghostscript if necessary."
(condition-case err
(let ((status (process-status process)))
(when (memq status '(exit signal))
(setq compilation-in-progress (delq process compilation-in-progress)))
(when (buffer-name (process-buffer process))
(with-current-buffer (process-buffer process)
(goto-char (point-max))
(insert-before-markers "\n" mode-name " " string)
(forward-char -1)
(insert " at "
(substring (current-time-string) 0 -5))
(forward-char 1)
(TeX-command-mode-line process)
(when (memq status '(exit signal))
;; process died.
;; Throw away culprit, go on.
(let* ((err (concat preview-gs-answer "\n"
(process-name process) " " string))
(ov (preview-gs-behead-outstanding err)))
(when (and (null ov) preview-gs-queue)
(save-excursion
(goto-char (if (marker-buffer (process-mark process))
(process-mark process)
(point-max)))
(insert-before-markers err)))
(delete-process process)
(if (or (null ov)
(eq status 'signal))
;; if process was killed explicitly by signal, or if nothing
;; was processed, we give up on the matter altogether.
(progn
(when preview-ps-file
(condition-case nil
(preview-delete-file preview-ps-file)
(file-error nil)))
(preview-gs-queue-empty))
;; restart only if we made progress since last call
(let (filenames)
(dolist (ov preview-gs-outstanding)
(setq filenames (overlay-get ov 'filenames))
(condition-case nil
(preview-delete-file (nth 1 filenames))
(file-error nil))
(setcdr filenames nil)))
(setq preview-gs-queue (nconc preview-gs-outstanding
preview-gs-queue))
(setq preview-gs-outstanding nil)
(preview-gs-restart)))))))
(error (preview-log-error err "Ghostscript" process)))
(preview-reraise-error process))
(defun preview-gs-filter (process string)
"Filter function for processing Ghostscript output.
Gets the usual PROCESS and STRING parameters, see
`set-process-filter' for a description."
(with-current-buffer (process-buffer process)
(setq preview-gs-answer (concat preview-gs-answer string))
(while (string-match "GS\\(<[0-9]+\\)?>" preview-gs-answer)
(let* ((pos (match-end 0))
(answer (substring preview-gs-answer 0 pos)))
(setq preview-gs-answer (substring preview-gs-answer pos))
(condition-case err
(preview-gs-transact process answer)
(error (preview-log-error err "Ghostscript filter" process))))))
(preview-reraise-error))
(defun preview-gs-restart ()
"Start a new Ghostscript conversion process."
(when preview-gs-queue
(if preview-gs-sequence
(setcar preview-gs-sequence (1+ (car preview-gs-sequence)))
(setq preview-gs-sequence (list 1)))
(setcdr preview-gs-sequence 1)
(let* ((process-connection-type nil)
(outfile (format "-sOutputFile=%s"
(file-relative-name
(format "%s/pr%d-%%d.%s"
(car TeX-active-tempdir)
(car preview-gs-sequence)
preview-gs-image-type))))
(process
(apply #'start-process
"Preview-Ghostscript"
(current-buffer)
preview-gs-command
outfile
preview-gs-command-line)))
(goto-char (point-max))
(insert-before-markers "Running `Preview-Ghostscript' with ``"
(mapconcat #'shell-quote-argument
(append
(list preview-gs-command
outfile)
preview-gs-command-line)
" ") "''\n")
(setq preview-gs-answer "")
(set-process-query-on-exit-flag process nil)
(set-process-sentinel process #'preview-gs-sentinel)
(set-process-filter process #'preview-gs-filter)
(process-send-string process preview-gs-init-string)
(setq mode-name "Preview-Ghostscript")
(push process compilation-in-progress)
(TeX-command-mode-line process)
(force-mode-line-update)
process)))
(defun preview-gs-open (&optional setup)
"Start a Ghostscript conversion pass.
SETUP may contain a parser setup function."
(let ((image-info (assq preview-image-type preview-gs-image-type-alist)))
(setq preview-gs-image-type (nth 1 image-info))
(setq preview-gs-sequence nil)
(setq preview-gs-command-line (append
preview-gs-options
(nthcdr 2 image-info))
preview-gs-init-string
(format "{DELAYSAFER{.setsafe}if}stopped pop\
/.preview-BP currentpagedevice/BeginPage get dup \
null eq{pop{pop}bind}if def\
<</BeginPage{currentpagedevice/PageSize get dup 0 get 1 ne exch 1 get 1 ne or\
{.preview-BP %s}{pop}ifelse}bind/PageSize[1 1]>>setpagedevice\
/preview-do{/.preview-ST[count 4 roll save]def dup length 0 eq\
{pop}{setpagedevice}{ifelse exec}\
stopped{handleerror quit}if \
.preview-ST aload pop restore}bind def "
(preview-gs-color-string
preview-colors
;; Compatibility for gs 9.27 with non-trivial
;; foreground color and dark background.
;; Suppress color adjustment with PDF backend
;; when `preview-pdf-color-adjust-method' is nil.
(and (not preview-pdf-color-adjust-method)
;; The switch `preview-parsed-pdfoutput' isn't
;; set before parsing the latex output, so use
;; heuristic here.
(with-current-buffer TeX-command-buffer
(and TeX-PDF-mode
(not (TeX-PDF-from-DVI))))))))
(preview-gs-queue-empty)
(preview-parse-messages (or setup #'preview-gs-dvips-process-setup))))
(defun preview-gs-color-value (value)
"Return string to be used as color value for an RGB component.
Conversion from Emacs color numbers (0 to 65535) in VALUE
to Ghostscript floats."
(format "%g" (/ value 65535.0)))
(defun preview-pdf-color-string (colors)
"Return a string that patches PDF foreground color to work properly."
(let ((fg (aref colors 1)))
(if fg
(cond ((eq preview-pdf-color-adjust-method t)
;; New code for gs > 9.27.
;; This assumes DELAYBIND feature, which is known to be
;; broken in gs 9.27 (and possibly, < 9.27).
;; <URL:https://lists.gnu.org/archive/html/auctex-devel/2019-07/msg00000.html>
;; DELAYBIND is sometimes mentioned in association with
;; security holes in the changelog of Ghostscript:
;; <URL:https://www.ghostscript.com/doc/9.27/History9.htm>
;; Thus we might have to be prepared for removal of this
;; feature in future Ghostscript.
(concat
"/initgraphics {
//initgraphics
/RG where {
pop "
(mapconcat #'preview-gs-color-value fg " ")
" 3 copy rg RG
} if
} bind def .bindnow "))
((eq preview-pdf-color-adjust-method 'compatible)
;; Traditional code for gs < 9.27.
(concat
"/GS_PDF_ProcSet GS_PDF_ProcSet dup maxlength dict copy dup begin\
/graphicsbeginpage{//graphicsbeginpage exec "
(mapconcat #'preview-gs-color-value fg " ")
" 3 copy rg RG}bind store end readonly store "))
(;; Do nothing otherwise.
t
"")))))
(defun preview-gs-color-string (colors &optional suppress-fgbg)
"Return a string setting up COLORS.
If optional argument SUPPRESS-FGBG is non-nil, behave as if FG/BG
colors were just the default value."
(let ((bg (and (not suppress-fgbg)
(aref colors 0)))
(fg (and (not suppress-fgbg)
(aref colors 1)))
(mask (aref colors 2))
(border (aref colors 3)))
(concat
(and (or (and mask border) (and bg (not fg)))
"gsave ")
(and bg
(concat
(mapconcat #'preview-gs-color-value bg " ")
" setrgbcolor clippath fill "))
(and mask border
(format "%s setrgbcolor false setstrokeadjust %g \
setlinewidth clippath strokepath \
matrix setmatrix true \
{2 index{newpath}if round exch round exch moveto pop false}\
{round exch round exch lineto}{curveto}{closepath}\
pathforall pop fill "
(mapconcat #'preview-gs-color-value mask " ")
(* 2 border)))
;; I hate antialiasing. Warp border to integral coordinates.
(and (or (and mask border) (and bg (not fg)))
"grestore ")
(and fg
(concat
(mapconcat #'preview-gs-color-value fg " ")
" setrgbcolor")))))
(defun preview-dvipng-color-string (colors res)
"Return color setup tokens for dvipng.
Makes a string of options suitable for passing to dvipng.
Pure borderless black-on-white will return an empty string."
(let
((bg (aref colors 0))
(fg (aref colors 1))
(mask (aref colors 2))
(border (aref colors 3)))
(concat
(and bg
(format "--bg \"rgb %s\" "
(mapconcat #'preview-gs-color-value bg " ")))
(and fg
(format "--fg \"rgb %s\" "
(mapconcat #'preview-gs-color-value fg " ")))
(and mask border
(format "--bd \"rgb %s\" "
(mapconcat #'preview-gs-color-value mask " ")))
(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)
(error "preview-image-type setting '%s unsupported by this Emacs"
preview-gs-image-type))
(setq preview-gs-command-line (append
preview-gs-command-line
(list (preview-gs-resolution
(preview-hook-enquiry preview-scale)
(car preview-resolution)
(cdr preview-resolution)))))
(if preview-parsed-pdfoutput
(preview-pdf2dsc-process-setup)
(let ((process (preview-start-dvips preview-fast-conversion)))
(setq TeX-sentinel-function #'preview-gs-dvips-sentinel)
(list process (current-buffer) TeX-active-tempdir preview-ps-file
preview-gs-image-type))))
(defun preview-dvipng-process-setup ()
"Set up dvipng process for conversion."
(setq preview-gs-command-line (append
preview-gs-command-line
(list (preview-gs-resolution
(preview-hook-enquiry preview-scale)
(car preview-resolution)
(cdr preview-resolution)))))
(if preview-parsed-pdfoutput
(if (preview-supports-image-type preview-gs-image-type)
(preview-pdf2dsc-process-setup)
(error "preview-image-type setting '%s unsupported by this Emacs"
preview-gs-image-type))
(unless (preview-supports-image-type preview-dvipng-image-type)
(error "preview-dvipng-image-type setting '%s unsupported by this Emacs"
preview-dvipng-image-type))
(let ((process (preview-start-dvipng)))
(setq TeX-sentinel-function #'preview-dvipng-sentinel)
(list process (current-buffer) TeX-active-tempdir t
preview-dvipng-image-type))))
(defun preview-pdf2dsc-process-setup ()
(let ((process (preview-start-pdf2dsc)))
(setq TeX-sentinel-function #'preview-pdf2dsc-sentinel)
(list process (current-buffer) TeX-active-tempdir preview-ps-file
preview-gs-image-type)))
(defun preview-dvips-abort ()
"Abort a Dvips run."
(preview-gs-queue-empty)
(condition-case nil
(delete-file
(let ((gsfile preview-gs-file))
(with-current-buffer TeX-command-buffer
(funcall (car gsfile) "dvi" t))))
(file-error nil))
(when preview-ps-file
(condition-case nil
(preview-delete-file preview-ps-file)
(file-error nil)))
(setq TeX-sentinel-function nil))
(defalias 'preview-dvipng-abort #'preview-dvips-abort)
; "Abort a DviPNG run.")
(defun preview-gs-dvips-sentinel (process _command &optional gsstart)
"Sentinel function for indirect rendering DviPS process.
The usual PROCESS and COMMAND arguments for
`TeX-sentinel-function' apply. Starts gs if GSSTART is set."
(condition-case err
(let ((status (process-status process))
(gsfile preview-gs-file))
(cond ((eq status 'exit)
(delete-process process)
(setq TeX-sentinel-function nil)
(condition-case nil
(delete-file
(with-current-buffer TeX-command-buffer
(funcall (car gsfile) "dvi" t)))
(file-error nil))
(if preview-ps-file
(preview-prepare-fast-conversion))
(when gsstart
(if preview-gs-queue
(preview-gs-restart)
(when preview-ps-file
(condition-case nil
(preview-delete-file preview-ps-file)
(file-error nil))))))
((eq status 'signal)
(delete-process process)
(preview-dvips-abort))))
(error (preview-log-error err "DviPS sentinel" process)))
(preview-reraise-error process))
(defun preview-pdf2dsc-sentinel (process _command &optional gsstart)
"Sentinel function for indirect rendering PDF process.
The usual PROCESS and COMMAND arguments for
`TeX-sentinel-function' apply. Starts gs if GSSTART is set."
(condition-case err
(let ((status (process-status process)))
(cond ((eq status 'exit)
(delete-process process)
(setq TeX-sentinel-function nil)
;; Add DELAYBIND option for adjustment of foreground
;; color to work.
(if (and (eq preview-pdf-color-adjust-method t)
(aref preview-colors 1))
(setq preview-gs-command-line (append
preview-gs-command-line
'("-dDELAYBIND"))))
(setq preview-gs-init-string
(concat preview-gs-init-string
(preview-pdf-color-string preview-colors)))
(preview-prepare-fast-conversion)
(when gsstart
(if preview-gs-queue
(preview-gs-restart)
(when preview-ps-file
(condition-case nil
(preview-delete-file preview-ps-file)
(file-error nil))))))
((eq status 'signal)
(delete-process process)
(preview-dvips-abort))))
(error (preview-log-error err "PDF2DSC sentinel" process)))
(preview-reraise-error process))
(defun preview-gs-close (process closedata)
"Clean up after PROCESS and set up queue accumulated in CLOSEDATA."
(setq preview-gs-queue (nconc preview-gs-queue closedata))
(if process
(if preview-gs-queue
(if TeX-process-asynchronous
(if (and (eq (process-status process) 'exit)
(null TeX-sentinel-function))
;; Process has already finished and run sentinel
(progn
(when preview-ps-file
(condition-case nil
(preview-delete-file preview-ps-file)
(file-error nil)))
(preview-gs-restart))
(setq TeX-sentinel-function
(let ((fun (if preview-parsed-pdfoutput
#'preview-pdf2dsc-sentinel
#'preview-gs-dvips-sentinel)))
(lambda (process command)
(funcall fun process command t)))))
(TeX-synchronous-sentinel "Preview-DviPS" (cdr preview-gs-file)
process))
;; pathological case: no previews although we sure thought so.
(delete-process process)
(unless (eq (process-status process) 'signal)
(preview-dvips-abort)))))
(defun preview-dvipng-sentinel (process _command &optional placeall)
"Sentinel function for indirect rendering DviPNG process.
The usual PROCESS and COMMAND arguments for
`TeX-sentinel-function' apply. Places all snippets if PLACEALL is set."
(condition-case err
(let ((status (process-status process)))
(cond ((eq status 'exit)
(delete-process process)
(setq TeX-sentinel-function nil)
(when placeall
(preview-dvipng-place-all)))
((eq status 'signal)
(delete-process process)
(preview-dvipng-abort))))
(error (preview-log-error err "DviPNG sentinel" process)))
(preview-reraise-error process))
(defun preview-dvipng-close (process closedata)
"Clean up after PROCESS and set up queue accumulated in CLOSEDATA."
(if preview-parsed-pdfoutput
(preview-gs-close process closedata)
(setq preview-gs-queue (nconc preview-gs-queue closedata))
(if process
(if preview-gs-queue
(if TeX-process-asynchronous
(if (and (eq (process-status process) 'exit)
(null TeX-sentinel-function))
;; Process has already finished and run sentinel
(preview-dvipng-place-all)
(setq TeX-sentinel-function (lambda (process command)
(preview-dvipng-sentinel
process
command
t))))
(TeX-synchronous-sentinel "Preview-DviPNG" (cdr preview-gs-file)
process))
;; pathological case: no previews although we sure thought so.
(delete-process process)
(unless (eq (process-status process) 'signal)
(preview-dvipng-abort))))))
(defun preview-dsc-parse (file)
"Parse DSC comments of FILE.
Return a vector with offset/length pairs corresponding to
the pages. Page 0 corresponds to the initialization section."
(with-temp-buffer
(set-buffer-multibyte nil)
(insert-file-contents-literally file)
(let ((last-pt (point-min))
trailer
pagelist
lastbegin
pt
case-fold-search
(level 0))
(while (search-forward-regexp "\
%%\\(?:\\(BeginDocument:\\)\\|\
\\(EndDocument[\n\r]\\)\\|\
\\(Page:\\)\\|\
\\(Trailer[\n\r]\\)\\)" nil t)
(setq pt (match-beginning 0))
(cond ((null (memq (char-before pt) '(?\C-j ?\C-m nil))))
(trailer (error "Premature %%%%Trailer in `%s' at offsets %d/%d"
file trailer pt))
((match-beginning 1)
(if (zerop level)
(setq lastbegin pt))
(setq level (1+ level)))
((match-beginning 2)
(if (zerop level)
(error "Unmatched %%%%EndDocument in `%s' at offset %d"
file pt)
(setq level (1- level))))
((> level 0))
((match-beginning 3)
(push (list last-pt (- pt last-pt)) pagelist)
(setq last-pt pt))
((match-beginning 4)
(setq trailer pt))))
(unless (zerop level)
(error "Unmatched %%%%BeginDocument in `%s' at offset %d"
file lastbegin))
(push (list last-pt
(- (or trailer (point-max)) last-pt)) pagelist)
(vconcat (nreverse pagelist)))))
(defun preview-gs-dsc-cvx (page dsc)
"Generate PostScript code accessing PAGE in the DSC object.
The returned PostScript code will need the file on
top of the stack, and will replace it with an executable
object corresponding to the wanted page."
(let ((curpage (aref dsc page)))
(format "dup %d setfileposition %d()/SubFileDecode filter cvx"
(1- (car curpage)) (nth 1 curpage))))
(defun preview-ps-quote-filename (str &optional nonrel)
"Make a PostScript string from filename STR.
The file name is first made relative unless
NONREL is not nil."
(unless nonrel (setq str (file-relative-name str)))
(let ((index 0))
(while (setq index (string-match "[\\()]" str index))
(setq str (replace-match "\\\\\\&" t nil str)
index (+ 2 index)))
(concat "(" str ")")))
(defun preview-prepare-fast-conversion ()
"This fixes up all parameters for fast conversion."
(let* ((file (if (consp (car preview-ps-file))
(if (consp (caar preview-ps-file))
(car (last (caar preview-ps-file)))
(caar preview-ps-file))
(car preview-ps-file)))
(all-files (if (and (consp (car preview-ps-file))
(consp (caar preview-ps-file)))
(caar preview-ps-file)
(list file))))
(setq preview-gs-dsc (preview-dsc-parse file))
(setq preview-gs-init-string
;; Add commands for revised file access controls introduced
;; after gs 9.27 (bug#37719)
(concat (format "systemdict /.addcontrolpath known {%s} if "
(mapconcat (lambda (f)
(format "/PermitFileReading %s .addcontrolpath"
(preview-ps-quote-filename f)))
all-files "\n"))
(format "{<</PermitFileReading[%s]>> setuserparams \
.locksafe} stopped pop "
(mapconcat #'preview-ps-quote-filename all-files ""))
preview-gs-init-string
(format " %s(r)file /.preview-ST 1 index def %s exec .preview-ST "
(preview-ps-quote-filename file)
(preview-gs-dsc-cvx 0 preview-gs-dsc))))))
(defun preview-gs-urgentize (ov buff)
"Make a displayed overlay render with higher priority.
This function is used in fake conditional display properties
for reordering the conversion order to prioritize on-screen
images. OV is the overlay in question, and BUFF is the
Ghostscript process buffer where the buffer-local queue
is located."
;; It does not matter that ov gets queued twice in that process: the
;; first version to get rendered will clear the 'queued property.
;; It cannot get queued more than twice since we remove the
;; conditional display property responsible for requeuing here.
;; We don't requeue if the overlay has been killed (its buffer made
;; nil). Not necessary, but while we are checking...
;; We must return t.
(preview-remove-urgentization ov)
(when (and (overlay-get ov 'queued)
(overlay-buffer ov))
(with-current-buffer buff
(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.
This enters OV into all proper queues in order to make it render
this image for real later, and returns the overlay after setting
a placeholder image. SNIPPET gives the number of the
snippet in question for the file to be generated.
BOX is a bounding box if we already know one via TeX.
RUN-BUFFER is the buffer of the TeX process,
TEMPDIR is the correct copy of `TeX-active-tempdir',
PS-FILE is a copy of `preview-ps-file', IMAGETYPE is the image type
for the file extension."
(overlay-put ov 'filenames
(unless (eq ps-file t)
(list
(preview-make-filename
(or ps-file
(format "preview.%03d" snippet))
tempdir))))
(overlay-put ov 'queued
(vector box nil snippet))
(overlay-put ov 'preview-image
(list (preview-icon-copy preview-nonready-icon)))
(preview-add-urgentization #'preview-gs-urgentize ov run-buffer)
(list ov))
(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
"*Preview-Ghostscript-Error*")))
(with-current-buffer buff
(kill-all-local-variables)
(set (make-local-variable 'view-exit-action) #'kill-buffer)
(setq buffer-undo-list t)
(erase-buffer)
(insert string)
(goto-char (point-min)))
(view-buffer-other-window buff)))
(defun preview-mouse-open-eps (file &optional position)
"Display eps FILE in a view buffer on click.
Place point at POSITION, else beginning of file."
(let ((default-mode
;; FIXME: Yuck! Just arrange for the file name to have the right
;; extension instead!
(assoc-default "x.ps" auto-mode-alist #'string-match))
(buff (get-file-buffer file)))
(save-excursion
(if buff
(pop-to-buffer buff)
(view-file-other-window file))
(if (and (eq major-mode (default-value 'major-mode))
default-mode)
(funcall default-mode))
(goto-char (or position (point-min)))
(message "%s" (substitute-command-keys "\
Try \\[ps-run-start] \\[ps-run-buffer] and \
\\<ps-run-mode-map>\\[ps-run-mouse-goto-error] on error offset.")))))
(defun preview-gs-flag-error (ov err)
"Make an eps error flag in overlay OV for ERR string."
(let* ((filenames (overlay-get ov 'filenames))
(file (car (nth 0 filenames)))
;; FIXME: This format isn't equal to actual invocation of gs
;; command constructed in `preview-gs-restart', which
;; contains "%d".
(outfile (format "-sOutputFile=%s"
(file-relative-name
(car (nth 1 filenames)))))
(ps-open
(let ((string
(concat
(mapconcat #'shell-quote-argument
(append (list
preview-gs-command
outfile)
preview-gs-command-line)
" ")
"\nGS>"
preview-gs-init-string
(aref (overlay-get ov 'queued) 1)
err)))
(lambda () (interactive "@") (preview-mouse-open-error string))))
(str
(preview-make-clickable
nil
preview-error-icon
"%s views error message
%s more options"
ps-open
(let ((args
(if preview-ps-file
(list
(if (consp (car file)) (nth 1 (car file)) (car file))
(nth 0 (aref preview-gs-dsc
(aref (overlay-get ov 'queued) 2))))
(list file))))
(lambda () (interactive)
(popup-menu
`("PostScript error"
["View error" ,ps-open]
["View source" ,(lambda () (interactive "@")
(apply #'preview-mouse-open-eps
args))])))))))
(overlay-put ov 'strings (cons str str))
(preview-toggle ov)))
(defun preview-gs-transact (process answer)
"Work off Ghostscript transaction.
This routine is the action routine called via the process filter.
The Ghostscript process buffer of PROCESS will already be selected, and
and the standard output of Ghostscript up to the next prompt will be
given as ANSWER."
(let ((ov (pop preview-gs-outstanding))
(have-error (not
(string-match "\\`GS\\(<[0-9]+\\)?>\\'" answer ))))
(when (and ov (overlay-buffer ov))
(let ((queued (overlay-get ov 'queued)))
(when queued
(let* ((bbox (aref queued 0))
(filenames (overlay-get ov 'filenames))
(oldfile (nth 0 filenames))
(newfile (nth 1 filenames)))
(if have-error
(preview-gs-flag-error ov answer)
(condition-case nil
(preview-delete-file oldfile)
(file-error nil))
(overlay-put ov 'filenames (cdr filenames))
(preview-replace-active-icon
ov
(preview-create-icon (car newfile)
preview-gs-image-type
(preview-ascent-from-bb
bbox)
(aref preview-colors 2))))
(overlay-put ov 'queued nil)))))
(while (and (< (length preview-gs-outstanding)
preview-gs-outstanding-limit)
(setq ov (pop preview-gs-queue)))
(let ((queued (overlay-get ov 'queued)))
(when (and queued
(not (memq ov preview-gs-outstanding))
(overlay-buffer ov))
(let* ((filenames (overlay-get ov 'filenames))
(oldfile (car (nth 0
(nconc filenames
(list
(preview-make-filename
(format "pr%d-%d.%s"
(car preview-gs-sequence)
(cdr preview-gs-sequence)
preview-gs-image-type)
TeX-active-tempdir))))))
(bbox (aset queued 0
(or (and preview-prefer-TeX-bb
(aref queued 0))
(and (stringp oldfile)
(preview-extract-bb
oldfile))
(aref queued 0)
(error "No bounding box"))))
(snippet (aref queued 2))
(gs-line
(format
"%s<<%s>>preview-do\n"
(if preview-ps-file
(concat "dup "
(preview-gs-dsc-cvx
snippet
preview-gs-dsc))
(format "%s(r)file cvx"
(preview-ps-quote-filename
(if (listp oldfile)
(car (last oldfile))
oldfile))))
(if preview-parsed-tightpage
""
(format "/PageSize[%g %g]/PageOffset[%g \
%g[1 1 dtransform exch]{0 ge{neg}if exch}forall]"
(- (aref bbox 2) (aref bbox 0))
(- (aref bbox 3) (aref bbox 1))
(aref bbox 0) (aref bbox 1))))))
(setcdr preview-gs-sequence (1+ (cdr preview-gs-sequence)))
(setq preview-gs-outstanding
(nconc preview-gs-outstanding
(list ov)))
(aset queued 1 gs-line)
;; ignore errors because of dying processes: they will get
;; caught by the sentinel, anyway.
(condition-case nil
(process-send-string
process
gs-line)
(error nil))))))
(unless preview-gs-outstanding
(condition-case nil
(process-send-eof process)
(error nil)))))
(defun preview-hook-enquiry (hook)
"Gets a value from a configured hook.
HOOK is a list or single item, for which the first resolving to
non-nil counts. Entries can be a callable function, or
a symbol that is consulted, or a value. Lists are evaluated
recursively."
(cond ((functionp hook)
(funcall hook))
((consp hook)
(let (res)
(while (and (not res) hook)
(setq res (preview-hook-enquiry (car hook))
hook (cdr hook)))
res))
((and (symbolp hook) (boundp hook))
(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
a fixed number."
:group 'preview-appearance
:type '(choice (function-item preview-scale-from-face)
(const 1.0)
(number :value 1.0)
(function :value preview-scale-from-face)))
(defcustom preview-default-document-pt 10
"Assumed document point size for `preview-scale-from-face'.
If the point size (such as 11pt) of the document cannot be
determined from the document options itself, assume this size.
This is for matching screen font size and previews."
:group 'preview-appearance
:type
'(choice (const :tag "10pt" 10)
(const :tag "11pt" 11)
(const :tag "12pt" 12)
(number :tag "Other" :value 11.0)))
(defcustom preview-document-pt-list '(preview-parsed-font-size
preview-auctex-font-size
preview-default-document-pt)
"How `preview-document-pt' figures out the document size."
:group 'preview-appearance
:type
'(repeat (choice
;; FIXME: It seems that the bug mentioned below doesn't exist
;; at least for emacs 27.2.
;; This is a bug: type function seems to match variables, too.
(restricted-sexp :match-alternatives (functionp)
:tag "Function" :value preview-auctex-font-size)
(variable :value preview-parsed-font-size)
(number :value 11))))
(defun preview-auctex-font-size ()
"Calculate the default font size of document.
If packages, classes or styles were called with an option
like 10pt, size is taken from the first such option if you
had let your document be parsed by AUCTeX."
(let* ((regexp "\\`\\([0-9]+\\)pt\\'")
(option
(or
(LaTeX-match-class-option regexp)
;; We don't have `LaTeX-match-package-option'.
(TeX-member regexp
(apply #'append
(mapcar #'cdr LaTeX-provided-package-options))
#'string-match))))
(if option (string-to-number (match-string 1 option)))))
(defsubst preview-document-pt ()
"Calculate the default font size of document."
(preview-hook-enquiry preview-document-pt-list))
(defun preview-scale-from-face ()
"Calculate preview scale from `preview-reference-face'.
This calculates the scale of EPS images from a document assumed
to have a default font size given by function `preview-document-pt'
so that they match the reference face in height."
(let ((d (/ (preview-inherited-face-attribute 'preview-reference-face :height
'default)
10.0)))
(lambda () (/ d (preview-document-pt)))))
(defvar preview-min-spec nil
"Value to filter out too large icons.
Icon specs with :size larger than this value is not used.
Appropriate value is determined at run time according to the
display in use.")
(defun preview-make-image (symbol)
"Make an image from a preview spec list.
The first spec that is workable (given the current setting of
`preview-min-spec') from the given SYMBOL is used here. The
icon is cached in the property list of the SYMBOL."
(let ((alist (get symbol 'preview-min-alist)))
(cdr (or
(assq preview-min-spec alist)
(car (put symbol 'preview-min-alist
(cons
(cons preview-min-spec
(preview-filter-specs
(symbol-value symbol)))
alist)))))))
(defun preview-filter-specs (spec-list)
"Find the first of the fitting specs and make an image."
(let (image)
(while (and spec-list
(not (setq image
(catch 'preview-filter-specs
(preview-filter-specs-1 (car spec-list))))))
(setq spec-list (cdr spec-list)))
image))
(defun preview-filter-specs-1 (specs)
(and specs
(if (get 'preview-filter-specs (car specs))
(apply (get 'preview-filter-specs (car specs)) specs)
`(,(nth 0 specs) ,(nth 1 specs)
,@(preview-filter-specs-1 (nthcdr 2 specs))))))
(put 'preview-filter-specs :min
#'(lambda (_keyword value &rest args)
(if (> value preview-min-spec)
(throw 'preview-filter-specs nil)
(preview-filter-specs-1 args))))
(put 'preview-filter-specs :file
#'(lambda (_keyword value &rest args)
`(:file ,(expand-file-name value (expand-file-name "images"
TeX-data-directory))
,@(preview-filter-specs-1 args))))
(defun preview-ascent-from-bb (bb)
"This calculates the image ascent from its bounding box.
The bounding box BB needs to be a 4-component vector of
numbers (can be float if available)."
;; baseline is at 1in from the top of letter paper (11in), so it is
;; at 10in from the bottom precisely, which is 720 in PostScript
;; coordinates. If our bounding box has its bottom not above this
;; line, and its top above, we can calculate a useful ascent value.
;; If not, something is amiss. We just use 100 in that case.
(let ((bottom (aref bb 1))
(top (aref bb 3)))
(if (and (<= bottom 720)
(> top 720))
(round (* 100.0 (/ (- top 720.0) (- top bottom))))
100)))
(defface preview-face '((((background dark))
(:background "dark slate gray"))
(t
(:background "beige")))
"Face to use for the preview source."
:group 'preview-appearance)
(defface preview-reference-face '((t nil))
"Face consulted for colors and scale of active previews.
2022-11-08 03:31:08 +00:00
Fallback to :inherit and \\='default implemented."
2022-08-25 17:42:37 +00:00
:group 'preview-appearance)
(defcustom preview-auto-reveal
'(eval (preview-arrived-via (key-binding [left]) (key-binding [right])
#'backward-char #'forward-char))
"Cause previews to open automatically when entered.
Possibilities are:
t autoopens,
nil doesn't,
a symbol will have its value consulted if it exists,
defaulting to nil if it doesn't.
An integer will specify a maximum cursor movement distance.
Larger movements won't open the preview.
A CONS-cell means to call a function for determining the value.
The CAR of the cell is the function to call which receives
the CDR of the CONS-cell in the rest of the arguments, while
point and current buffer point to the position in question.
All of the options show reasonable defaults."
:group 'preview-appearance
:type '(choice (const :tag "Off" nil)
(const :tag "On" t)
(symbol :tag "Indirect variable" :value reveal-mode)
(integer :tag "Maximum distance" :value 1)
(cons :tag "Function call"
:value (eval (preview-arrived-via
(key-binding [left])
(key-binding [right])))
function (list :tag "Argument list"
(repeat :inline t sexp)))))
(defun preview-auto-reveal-p (mode distance)
"Decide whether to auto-reveal.
Return non-nil if region should be auto-opened.
See `preview-auto-reveal' for definitions of MODE, which gets
set to `preview-auto-reveal'. DISTANCE specifies the movement
distance with which point has been reached in case it has been
a movement starting in the current buffer."
(cond ((symbolp mode)
(and (boundp mode)
(symbol-value mode)))
((integerp mode)
(and distance (/= 0 distance) (<= (abs distance) mode)))
((consp mode)
(apply (car mode) (cdr mode)))
(t mode)))
(defun preview-arrived-via (&rest list)
"Indicate auto-opening.
Return non-nil if called by one of the commands in LIST."
(memq this-command list))
(defcustom preview-equality-transforms '(identity
preview-canonical-spaces)
"Transformation functions for region changes.
These functions are tried in turn on the strings from the
regions of a preview to decide whether a preview is to be considered
changed. If any transform leads to equal results, the preview is
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 nil
"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
2022-11-08 03:31:08 +00:00
the heuristic-mask setting of images to default to t since
2022-08-25 17:42:37 +00:00
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
2022-11-08 03:31:08 +00:00
interpreted as PostScript points (1/72 of 1in)."
2022-08-25 17:42:37 +00:00
: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'.
Return 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,
2022-11-08 03:31:08 +00:00
nil displays the underlying text, and `toggle' toggles.
2022-08-25 17:42:37 +00:00
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))))
(defun preview--open-for-replace (beg end &rest _)
"Make `query-replace' open preview text about to be replaced."
(preview-open-overlays (overlays-in beg end)))
(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
(advice-add 'replace-highlight :before
#'preview--open-for-replace)
(advice-remove 'replace-highlight
#'preview--open-for-replace)))
: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
`preview-equality-transforms' on them until it is exhausted
or one transform returns equality."
(let ((lst preview-equality-transforms))
(while (and lst (not (apply #'string= (mapcar (car lst) args))))
(setq lst (cdr lst)))
lst))
(defun preview-canonical-spaces (arg)
"Convert ARG into canonical form.
Removes comments and collapses white space, except for multiple newlines."
(let (pos)
(while (setq pos (string-match "\\s<.*[\n\r][ \t]*" arg pos))
(setq arg (replace-match "" t t arg 0)))
(while (setq pos (string-match "[ \t]*\\(\\([ \t]\\)\\|[\n\r][ \t]*\\)"
arg pos))
(setq arg (replace-match (if (match-beginning 2) " " "\n") t t arg 0)
pos (1+ pos)))
(while (setq pos (string-match "\n+" arg pos))
(if (string= "\n" (match-string 0 arg))
(setq arg (replace-match " " t t arg 0)
pos (1+ pos))
(setq pos (match-end 0)))))
arg)
(defun preview-regenerate (ovr)
"Pass the modified region in OVR again through LaTeX."
(let ((begin (overlay-start ovr))
(end (overlay-end ovr)))
(with-current-buffer (overlay-buffer ovr)
(preview-delete ovr)
(preview-region begin end))))
(defcustom preview-inner-environments '("Bmatrix" "Vmatrix" "aligned"
"array" "bmatrix" "cases"
"gathered" "matrix" "pmatrix"
"smallmatrix" "split"
"subarray" "vmatrix")
"Environments not to be previewed on their own."
:group 'preview-latex
:type '(repeat string))
(defun preview-next-border (backwards)
"Search for the next interesting border for `preview-at-point'.
Searches backwards if BACKWARDS is non-nil."
(let (history preview-state (pt (point)))
(catch 'exit
(while
(null
(memq
(setq preview-state
(if backwards
(if (> (setq pt
(previous-single-char-property-change
pt 'preview-state)) (point-min))
(get-char-property (1- pt) 'preview-state)
(throw 'exit (or history (point-min))))
(if (< (setq pt
(next-single-char-property-change
pt 'preview-state)) (point-max))
(get-char-property pt 'preview-state)
(throw 'exit (or history (point-max))))))
'(active inactive)))
(setq history (and (not preview-state) pt)))
(or history pt))))
(defun preview-at-point ()
"Do the appropriate preview thing at point.
If point is positioned on or inside of an unmodified preview area,
its visibility is toggled.
If not, the surroundings are run through preview. The
surroundings don't extend into unmodified previews or past
contiguous previews invalidated by modifications.
Overriding any other action, if a region is
active (`transient-mark-mode'), it is run through `preview-region'."
(interactive)
(if (TeX-active-mark)
(preview-region (region-beginning) (region-end))
(catch 'exit
(dolist (ovr (overlays-in (max (point-min) (1- (point)))
(min (point-max) (1+ (point)))))
(let ((preview-state (overlay-get ovr 'preview-state)))
(when preview-state
(unless (eq preview-state 'disabled)
(preview-toggle ovr 'toggle (selected-window))
(throw 'exit t)))))
(preview-region (preview-next-border t)
(preview-next-border nil)))))
(defun preview-disabled-string (ov)
"Generate a before-string for disabled preview overlay OV."
(concat (preview-make-clickable
(overlay-get ov 'preview-map)
preview-icon
"\
%s regenerates preview
%s more options"
(lambda () (interactive) (preview-regenerate ov)))
;; icon on separate line only for stuff starting on its own line
(with-current-buffer (overlay-buffer ov)
(save-excursion
(save-restriction
(widen)
(goto-char (overlay-start ov))
(if (bolp) "\n" ""))))))
(defun preview-disable (ovr)
"Change overlay behaviour of OVR after source edits."
(overlay-put ovr 'queued nil)
(preview-remove-urgentization ovr)
(overlay-put ovr 'preview-image nil)
(overlay-put ovr 'timestamp nil)
(setcdr (overlay-get ovr 'strings) (preview-disabled-string ovr))
(preview-toggle ovr)
(overlay-put ovr 'preview-state 'disabled)
(dolist (filename (overlay-get ovr 'filenames))
(condition-case nil
(preview-delete-file filename)
(file-error nil))
(overlay-put ovr 'filenames nil)))
(defun preview-delete (ovr &rest _ignored)
"Delete preview overlay OVR, taking any associated file along.
IGNORED arguments are ignored, making this function usable as
a hook in some cases"
(let ((filenames (overlay-get ovr 'filenames)))
(overlay-put ovr 'filenames nil)
(delete-overlay ovr)
(dolist (filename filenames)
(condition-case nil
(preview-delete-file filename)
(file-error nil)))))
(defun preview-clearout (&optional start end timestamp)
"Clear out all previews in the current region.
When called interactively, the current region is used.
Non-interactively, the region between START and END is
affected. Those two values default to the borders of
the entire buffer. If TIMESTAMP is non-nil, previews
with a `timestamp' property of it are kept."
(interactive "r")
(dolist (ov (overlays-in (or start (point-min))
(or end (point-max))))
(and (overlay-get ov 'preview-state)
(not (and timestamp
(equal timestamp (overlay-get ov 'timestamp))))
(preview-delete ov))))
(defun preview-clearout-buffer (&optional buffer)
"Clearout BUFFER from previews, current buffer if nil."
(interactive)
(if buffer
(with-current-buffer buffer (preview-clearout))
(preview-clearout)))
(defun preview-clearout-section ()
"Clearout previews from LaTeX section."
(interactive)
(save-excursion
(LaTeX-mark-section)
(preview-clearout (region-beginning) (region-end))))
(defun preview-clearout-at-point ()
"Clearout any preview at point."
(interactive)
(preview-clearout (max (point-min) (1- (point)))
(min (point-max) (1+ (point)))))
(defun preview-walk-document (func)
"Cycle through all buffers belonging to current document.
Each buffer having the same master file as the current file
has FUNC called with its current buffer being set to it."
(let* ((buffers (buffer-list))
(master (expand-file-name (TeX-master-file t)))
(default-buffers (list (current-buffer)
(find-buffer-visiting master))))
(while buffers
(with-current-buffer (pop buffers)
(when
(or (memq (current-buffer) default-buffers)
(and (memq major-mode '(plain-tex-mode latex-mode))
(or (stringp TeX-master)
(eq TeX-master t))
(string= (expand-file-name (TeX-master-file t))
master)))
(funcall func))))))
(defun preview-clearout-document ()
"Clear out all previews in current document.
The document consists of all buffers that have the same master file
as the current buffer. This makes the current document lose
all previews."
(interactive)
(preview-walk-document #'preview-clearout-buffer))
(defun preview-kill-buffer-cleanup (&optional buf)
"This is a cleanup function just for use in hooks.
Cleans BUF or current buffer. The difference to
`preview-clearout-buffer' is that previews
associated with the last buffer modification time are
kept."
(with-current-buffer (or buf (current-buffer))
(save-restriction
(widen)
(preview-clearout (point-min) (point-max) (visited-file-modtime)))))
(add-hook 'kill-buffer-hook #'preview-kill-buffer-cleanup)
(add-hook 'before-revert-hook #'preview-kill-buffer-cleanup)
(defvar preview-last-counter nil
"Last counter information.")
(defun preview-extract-counters (ctr)
(setq preview-last-counter
(prog1 (copy-sequence ctr)
(dolist (elt preview-last-counter)
(setq ctr (delete elt ctr)))))
(apply #'concat ctr))
(defun desktop-buffer-preview-misc-data (&rest _ignored)
"Hook function that extracts previews for persistent sessions."
(unless (buffer-modified-p)
(setq preview-last-counter nil)
(save-restriction
(widen)
(let (save-info (timestamp (visited-file-modtime)))
(dolist (ov (sort (overlays-in (point-min) (point-max))
(lambda (x y) (< (overlay-start x)
(overlay-start y)))))
(when (and (memq (overlay-get ov 'preview-state) '(active inactive))
(null (overlay-get ov 'queued))
(cdr (overlay-get ov 'preview-image)))
(push (preview-dissect ov timestamp) save-info)))
(and save-info
(cons 'preview (cons timestamp (nreverse save-info))))))))
(defvar preview-temp-dirs nil
"List of top level temporary directories in use from preview.
Any directory not in this list will be cleared out by preview
on first use.")
(defun preview-dissect (ov timestamp)
"Extract all persistent data from OV and TIMESTAMP it."
(let ((filenames (butlast (nth 0 (overlay-get ov 'filenames)))))
(overlay-put ov 'timestamp timestamp)
(list (overlay-start ov)
(overlay-end ov)
(cdr (overlay-get ov 'preview-image))
filenames
(let ((ctr (overlay-get ov 'preview-counters)))
(and ctr
(cons (preview-extract-counters (car ctr))
(preview-extract-counters (cdr ctr))))))))
(defun preview-buffer-restore-internal (buffer-misc)
"Restore previews from BUFFER-MISC if proper.
Remove them if they have expired."
(let ((timestamp (visited-file-modtime)) tempdirlist files)
(setq preview-parsed-counters nil)
(when (eq 'preview (pop buffer-misc))
(preview-get-geometry)
(if (equal (pop buffer-misc) timestamp)
(dolist (ovdata buffer-misc)
(setq tempdirlist
(apply #'preview-reinstate-preview tempdirlist
timestamp ovdata)))
(dolist (ovdata buffer-misc)
(setq files (nth 3 ovdata))
(condition-case nil
(delete-file (nth 0 files))
(file-error nil))
(unless (member (nth 1 files) tempdirlist)
(push (nth 1 files) tempdirlist)))
(dolist (dir tempdirlist)
(condition-case nil
(delete-directory dir)
(file-error nil)))))))
(defun preview-buffer-restore (buffer-misc)
"At end of desktop load, reinstate previews.
This delay is so that minor modes changing buffer positions
\(like `x-symbol-mode' does) will not wreak havoc.
BUFFER-MISC is the appropriate data to be used."
(add-hook 'desktop-delay-hook
(let ((buf (current-buffer)))
(lambda ()
(with-current-buffer buf
(preview-buffer-restore-internal
buffer-misc))))))
2022-11-08 03:31:08 +00:00
;; Add autoload cookies explicitly for desktop.el.
;; <Background> preview-latex doesn't conform to the following
;; assumptions of desktop.el:
;; (1) The file associated with the major mode by autoload has defun
;; of handler, which restores the state of the buffer.
;; (2) The file has suitable `add-to-list' form also for
;; `desktop-buffer-mode-handlers' to register the entry of the
;; handler.
;; This isn't the case here because the file associated with
;; `latex-mode' is tex-mode.el, neither preview.el nor latex.el. Thus
;; we include both of them as explicit autoloads in preview-latex.el.
;;;###autoload
2022-08-25 17:42:37 +00:00
(defun desktop-buffer-preview (file-name _buffer-name misc)
"Hook function for restoring persistent previews into a buffer."
(when (and file-name (file-readable-p file-name))
(let ((buf (find-file-noselect file-name)))
(if (eq (car misc) 'preview)
(with-current-buffer buf
(preview-buffer-restore misc)
buf)
buf))))
2022-11-08 03:31:08 +00:00
;;;###autoload
(add-to-list 'desktop-buffer-mode-handlers
'(latex-mode . desktop-buffer-preview))
2022-08-25 17:42:37 +00:00
(defcustom preview-auto-cache-preamble 'ask
"Whether to generate a preamble cache format automatically.
Possible values are nil, t, and `ask'."
:group 'preview-latex
:type '(choice (const :tag "Cache" t)
(const :tag "Don't cache" nil)
(const :tag "Ask" ask)))
(defvar preview-dumped-alist nil
"Alist of dumped masters.
The elements are (NAME . ASSOC). NAME is the master file name
\(without extension), ASSOC is what to do with regard to this
format. Possible values: nil means no format is available
and none should be generated. t means no format is available,
it should be generated on demand. If the value is a cons cell,
the CAR of the cons cell is the command with which the format
has been generated, and the CDR is some Emacs-flavor specific
value used for maintaining a watch on possible changes of the
preamble.")
(defun preview-cleanout-tempfiles ()
"Clean out all directories and files with non-persistent data.
This is called as a hook when exiting Emacs."
(mapc #'preview-kill-buffer-cleanup (buffer-list))
(mapc #'preview-format-kill preview-dumped-alist))
(defun preview-inactive-string (ov)
"Generate before-string for an inactive preview overlay OV.
This is for overlays where the source text has been clicked
visible. For efficiency reasons it is expected that the buffer
is already selected and unnarrowed."
(concat
(preview-make-clickable (overlay-get ov 'preview-map)
preview-icon
"\
%s redisplays preview
%s more options")
;; icon on separate line only for stuff starting on its own line
(with-current-buffer (overlay-buffer ov)
(save-excursion
(save-restriction
(widen)
(goto-char (overlay-start ov))
(if (bolp) "\n" ""))))))
(defun preview-dvipng-place-all ()
"Place all images dvipng has created, if any.
Deletes the dvi file when finished."
(let (filename queued oldfiles snippet)
(dolist (ov (prog1 preview-gs-queue (setq preview-gs-queue nil)))
(when (and (setq queued (overlay-get ov 'queued))
(setq snippet (aref (overlay-get ov 'queued) 2))
(setq filename (preview-make-filename
(format "prev%03d.%s"
snippet preview-dvipng-image-type)
TeX-active-tempdir)))
(if (file-exists-p (car filename))
(progn
(overlay-put ov 'filenames (list filename))
(preview-replace-active-icon
ov
(preview-create-icon (car filename)
preview-dvipng-image-type
(preview-ascent-from-bb
(aref queued 0))
(aref preview-colors 2)))
(overlay-put ov 'queued nil))
(push filename oldfiles)
(overlay-put ov 'filenames nil)
(push ov preview-gs-queue))))
(if (setq preview-gs-queue (nreverse preview-gs-queue))
(progn
(preview-start-dvips preview-fast-conversion)
(setq TeX-sentinel-function (lambda (process command)
(preview-gs-dvips-sentinel
process
command
t)))
(dolist (ov preview-gs-queue)
(setq snippet (aref (overlay-get ov 'queued) 2))
(overlay-put ov 'filenames
(list
(preview-make-filename
(or preview-ps-file
(format "preview.%03d" snippet))
TeX-active-tempdir))))
(while (setq filename (pop oldfiles))
(condition-case nil
(preview-delete-file filename)
(file-error nil))))
(condition-case nil
(let ((gsfile preview-gs-file))
(delete-file
(with-current-buffer TeX-command-buffer
(funcall (car gsfile) "dvi" t))))
(file-error nil)))))
(defun preview-active-string (ov)
"Generate before-string for active image overlay OV."
(preview-make-clickable
(overlay-get ov 'preview-map)
(car (overlay-get ov 'preview-image))
"%s opens text
%s more options"))
(defun preview-make-filename (file tempdir)
"Generate a preview filename from FILE and TEMPDIR.
Filenames consist of a CONS-cell with absolute file name as CAR
and TEMPDIR as CDR. TEMPDIR is a copy of `TeX-active-tempdir'
with the directory name, the reference count and its top directory
name elements. If FILE is already in that form, the file name itself
gets converted into a CONS-cell with a name and a reference count."
(if (consp file)
(progn
(if (consp (car file))
(setcdr (car file) (1+ (cdr (car file))))
(setcar file (cons (car file) 1)))
file)
(setcar (nthcdr 2 tempdir) (1+ (nth 2 tempdir)))
(cons (expand-file-name file (nth 0 tempdir))
tempdir)))
(defun preview-attach-filename (attached file)
"Attaches the absolute file name ATTACHED to FILE."
(if (listp (caar file))
(setcar (car file) (cons attached (caar file)))
(setcar (car file) (list attached (caar file))))
file)
(defun preview-delete-file (file)
"Delete a preview FILE.
See `preview-make-filename' for a description of the data
structure. If the containing directory becomes empty,
it gets deleted as well."
(let ((filename
(if (consp (car file))
(and (zerop
(setcdr (car file) (1- (cdr (car file)))))
(car (car file)))
(car file))))
(if filename
(unwind-protect
(if (listp filename)
(dolist (elt filename) (delete-file elt))
(delete-file filename))
(let ((tempdir (cdr file)))
(when tempdir
(if (> (nth 2 tempdir) 1)
(setcar (nthcdr 2 tempdir) (1- (nth 2 tempdir)))
(setcdr file nil)
(delete-directory (nth 0 tempdir)))))))))
(defvar preview-buffer-has-counters nil)
(make-variable-buffer-local 'preview-buffer-has-counters)
(defun preview-place-preview (snippet start end
box counters tempdir place-opts)
"Generate and place an overlay preview image.
This generates the filename for the preview
snippet SNIPPET in the current buffer, and uses it for the
region between START and END. BOX is an optional preparsed
TeX bounding BOX passed on to the `place' hook.
COUNTERS is the info about saved counter structures.
TEMPDIR is a copy of `TeX-active-tempdir'.
PLACE-OPTS are additional arguments passed into
`preview-parse-messages'. Return
a list with additional info from the placement hook.
Those lists get concatenated together and get passed
to the close hook."
(preview-clearout start end tempdir)
(let ((ov (make-overlay start end nil nil nil)))
(overlay-put ov 'priority (TeX-overlay-prioritize start end))
(overlay-put ov 'preview-map
(preview-make-clickable
nil nil nil
(lambda (event) (interactive "e")
(preview-toggle ov 'toggle event))
(lambda (event) (interactive "e")
(preview-context-menu ov event))))
(overlay-put ov 'timestamp tempdir)
(when (cdr counters)
(overlay-put ov 'preview-counters counters)
(setq preview-buffer-has-counters t))
(prog1 (apply #'preview-call-hook 'place ov snippet box
place-opts)
(overlay-put ov 'strings
(list (preview-active-string ov)))
(preview-toggle ov t))))
(defun preview-counter-find (begin)
"Fetch the next preceding or next preview-counters property.
Factored out because of compatibility macros XEmacs would
not use in advice."
(or (car (get-char-property begin 'preview-counters))
(cdr (get-char-property (max (point-min)
(1- begin))
'preview-counters))
(cdr (get-char-property
(max (point-min)
(1- (previous-single-char-property-change
begin
'preview-counters)))
'preview-counters))
(car (get-char-property
(next-single-char-property-change begin 'preview-counters)
'preview-counters))))
(defun preview--counter-information (begin)
"Return repeated \\setcounter declaration based on point BEGIN.
If `preview-buffer-has-counters' is non-nil, return string to
insert into region tex file containing as many
\\setcounter{COUNTER}{VALUE} as possible built from
`preview-counters' property near the point BEGIN. Otherwise,
return nil."
(if preview-buffer-has-counters
(mapconcat
#'identity
(cons
""
(preview-counter-find begin))
"\\setcounter")))
(defun preview-reinstate-preview (tempdirlist timestamp start end
image filename &optional counters)
"Reinstate a single preview.
This gets passed TEMPDIRLIST, a list consisting of the kind
of entries used in `TeX-active-tempdir', and TIMESTAMP, the
time stamp under which the file got read in. It returns an augmented
list. START and END give the buffer location where the preview
is to be situated, IMAGE the image to place there, and FILENAME
the file to use: a triple consisting of filename, its temp directory
and the corresponding topdir. COUNTERS is saved counter information,
if any."
(when
(or (null filename) (file-readable-p (car filename)))
(when filename
(unless (equal (nth 1 filename) (car TeX-active-tempdir))
(setq TeX-active-tempdir
(or (assoc (nth 1 filename) tempdirlist)
(car (push (append (cdr filename) (list 0))
tempdirlist))))
(setcar (cdr TeX-active-tempdir)
(car (or (member (nth 1 TeX-active-tempdir)
preview-temp-dirs)
(progn
(add-hook 'kill-emacs-hook
#'preview-cleanout-tempfiles t)
(push (nth 1 TeX-active-tempdir)
preview-temp-dirs))))))
(setcar (nthcdr 2 TeX-active-tempdir)
(1+ (nth 2 TeX-active-tempdir)))
(setcdr filename TeX-active-tempdir)
(setq filename (list filename)))
(let ((ov (make-overlay start end nil nil nil)))
(overlay-put ov 'priority (TeX-overlay-prioritize start end))
(overlay-put ov 'preview-map
(preview-make-clickable
nil nil nil
(lambda (event) (interactive "e")
(preview-toggle ov 'toggle event))
(lambda (event) (interactive "e")
(preview-context-menu ov event))))
(when counters
(overlay-put
ov 'preview-counters
(cons
(mapcar #'cdr
(if (string= (car counters) "")
preview-parsed-counters
(setq preview-parsed-counters
(preview-parse-counters (car counters)))))
(mapcar #'cdr
(if (string= (cdr counters) "")
preview-parsed-counters
(setq preview-parsed-counters
(preview-parse-counters (cdr counters)))))))
(setq preview-buffer-has-counters t))
(overlay-put ov 'filenames filename)
(overlay-put ov 'preview-image (cons (preview-import-image image)
image))
(overlay-put ov 'strings
(list (preview-active-string ov)))
(overlay-put ov 'timestamp timestamp)
(preview-toggle ov t)))
tempdirlist)
(defun preview-back-command (&optional nocomplex)
"Move backward a TeX token.
If NOCOMPLEX is set, only basic tokens and no argument sequences
will be skipped over backwards."
(let ((oldpos (point)) oldpoint)
(condition-case nil
(or (search-backward-regexp "\\(\\$\\$?\
\\|\\\\[^a-zA-Z@]\
\\|\\\\[a-zA-Z@]+\
\\|\\\\begin[ \t]*{[^}]+}\
\\)\\=" (line-beginning-position) t)
nocomplex
(if (eq ?\) (char-syntax (char-before)))
(while
(progn
(setq oldpoint (point))
(backward-sexp)
(and (not (eq oldpoint (point)))
(eq ?\( (char-syntax (char-after))))))
(backward-char)))
(error (goto-char oldpos)))))
(defcustom preview-required-option-list '("active" "tightpage" "auctex"
(preview-preserve-counters
"counters"))
"Specifies required options passed to the preview package.
These are passed regardless of whether there is an explicit
\\usepackage of that package present."
:group 'preview-latex
:type preview-expandable-string)
(defcustom preview-preserve-counters nil
"Try preserving counters for partial runs if set."
:group 'preview-latex
:type 'boolean)
(defcustom preview-default-option-list '("displaymath" "floats"
"graphics" "textmath" "sections"
"footnotes")
"Specifies default options to pass to preview package.
These options are only used when the LaTeX document in question does
not itself load the preview package, namely when you use preview
on a document not configured for preview. \"auctex\", \"active\",
\"dvips\" and \"delayed\" need not be specified here."
:group 'preview-latex
:type '(list (set :inline t :tag "Options known to work"
:format "%t:\n%v%h" :doc
"The above options are all the useful ones
at the time of the release of this package.
You should not need \"Other options\" unless you
upgraded to a fancier version of just the LaTeX style.
Please also note that `psfixbb' fails to have an effect if
`preview-fast-conversion' or `preview-prefer-TeX-bb'
are selected."
(const "displaymath")
(const "floats")
(const "graphics")
(const "textmath")
(const "sections")
(const "footnotes")
(const "showlabels")
(const "psfixbb"))
(set :tag "Expert options" :inline t
:format "%t:\n%v%h" :doc
"Expert options should not be enabled permanently."
(const "noconfig")
(const "showbox")
(const "tracingall"))
(repeat :inline t :tag "Other options" (string))))
(defcustom preview-default-preamble
'("\\RequirePackage[" ("," . preview-default-option-list)
"]{preview}[2004/11/05]")
"Specifies default preamble code to add to a LaTeX document.
If the document does not itself load the preview package, that is,
when you use preview on a document not configured for preview, this
list of LaTeX commands is inserted just before \\begin{document}."
:group 'preview-latex
:type preview-expandable-string)
(defcustom preview-LaTeX-command '("%`%l \"\\nonstopmode\\nofiles\
\\PassOptionsToPackage{" ("," . preview-required-option-list) "}{preview}\
\\AtBeginDocument{\\ifx\\ifPreview\\undefined"
preview-default-preamble "\\fi}\"%' \"\\detokenize{\" %(t-filename-only) \"}\"")
;; Since TeXLive 2018, the default encoding for LaTeX files has been
;; changed to UTF-8 if used with classic TeX or pdfTeX. I.e.,
;; \usepackage[utf8]{inputenc} is enabled by default in (pdf)latex.
;; c.f. LaTeX News issue 28
;; Due to this change, \detokenize is required to recognize
;; non-ascii characters in the file name when \input is supplemented
;; implicitly by %`-%' pair.
"Command used for starting a preview.
See description of `TeX-command-list' for details."
:group 'preview-latex
:type preview-expandable-string)
(defun preview-goto-info-page ()
"Read documentation for preview-latex in the info system."
(interactive)
(info "(preview-latex)"))
(eval-after-load 'info '(add-to-list 'Info-file-list-for-emacs
'("preview" . "preview-latex")))
(defvar preview-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-p" #'preview-at-point)
(define-key map "\C-r" #'preview-region)
(define-key map "\C-b" #'preview-buffer)
(define-key map "\C-d" #'preview-document)
(define-key map "\C-f" #'preview-cache-preamble)
(define-key map "\C-c\C-f" #'preview-cache-preamble-off)
(define-key map "\C-i" #'preview-goto-info-page)
;; (define-key map "\C-q" #'preview-paragraph)
(define-key map "\C-e" #'preview-environment)
(define-key map "\C-s" #'preview-section)
(define-key map "\C-w" #'preview-copy-region-as-mml)
(define-key map "\C-c\C-p" #'preview-clearout-at-point)
(define-key map "\C-c\C-r" #'preview-clearout)
(define-key map "\C-c\C-s" #'preview-clearout-section)
(define-key map "\C-c\C-b" #'preview-clearout-buffer)
(define-key map "\C-c\C-d" #'preview-clearout-document)
map))
(defun preview-copy-text (ov)
"Copy the text of OV into the kill buffer."
(with-current-buffer (overlay-buffer ov)
(copy-region-as-kill (overlay-start ov) (overlay-end ov))))
(defun preview-copy-mml (ov)
"Copy an MML representation of OV into the kill buffer.
This can be used to send inline images in mail and news when
using MML mode."
(when (catch 'badcolor
(let ((str (car (preview-format-mml ov))))
(if str
(if (eq last-command #'kill-region)
(kill-append str nil)
(kill-new str))
(error "No image file available")))
nil)
(let (preview-transparent-border)
(preview-regenerate ov))))
(defun preview-copy-region-as-mml (start end)
(interactive "r")
(when (catch 'badcolor
(let (str lst dont-ask)
(dolist (ov (overlays-in start end))
(when (setq str (preview-format-mml ov dont-ask))
(setq dont-ask (cdr str))
(and
(>= (overlay-start ov) start)
(<= (overlay-end ov) end)
(push (list (- (overlay-start ov) start)
(- (overlay-end ov) start)
(car str)) lst))))
(setq str (buffer-substring start end))
(dolist (elt (nreverse (sort lst #'car-less-than-car)))
(setq str (concat (substring str 0 (nth 0 elt))
(nth 2 elt)
(substring str (nth 1 elt)))))
(if (eq last-command #'kill-region)
(kill-append str nil)
(kill-new str)))
nil)
(let (preview-transparent-border)
(preview-region start end))))
(autoload 'mailcap-extension-to-mime "mailcap")
(defun preview-format-mml (ov &optional dont-ask)
"Return an MML representation of OV as string.
This can be used to send inline images in mail and news when
using MML mode. If there is nothing current available,
nil is returned. If the image has a colored border and the
user wants it removed when asked (unless DONT-ASK is set),
`badcolor' is thrown a t. The MML is returned in the car of the
result, DONT-ASK in the cdr."
(and (memq (overlay-get ov 'preview-state) '(active inactive))
(not (overlay-get ov 'queued))
(let* ((text (with-current-buffer (overlay-buffer ov)
(buffer-substring (overlay-start ov)
(overlay-end ov))))
(image (cdr (overlay-get ov 'preview-image)))
file type)
(cond ((consp image)
(and (not dont-ask)
(nth 3 image)
(if (y-or-n-p "Replace colored borders? ")
(throw 'badcolor t)
(setq dont-ask t)))
(setq file (car (car (last (overlay-get ov 'filenames))))
type (mailcap-extension-to-mime
(file-name-extension file)))
(cons
(format "<#part %s
description=\"%s\"
filename=%s>
<#/part>"
(if type
(format "type=\"%s\" disposition=inline" type)
"disposition=attachment")
(if (string-match "[\n\"]" text)
"preview-latex image"
text)
(if (string-match "[ \n<>]" file)
(concat "\"" file "\"")
file))
dont-ask))
((stringp image)
(cons image dont-ask))))))
(defun preview-active-contents (ov)
"Check whether we have a valid image associated with OV."
(and (memq (overlay-get ov 'preview-state) '(active inactive)) t))
(defun preview-context-menu (ov ev)
"Pop up a menu for OV at position EV."
(popup-menu
`("Preview"
["Toggle" (preview-toggle ,ov 'toggle ',ev)
(preview-active-contents ,ov)]
["Regenerate" (preview-regenerate ,ov)]
["Remove" (preview-delete ,ov)]
["Copy text" (preview-copy-text ,ov)]
["Copy MIME" (preview-copy-mml ,ov)
(preview-active-contents ,ov)])
ev))
(defvar preview-TeX-style-dir)
(defun preview-TeX-style-cooked ()
"Return `preview-TeX-style-dir' in cooked form.
This will be fine for prepending to a `TEXINPUTS' style
environment variable, including an initial `.' at the front."
(if (or (zerop (length preview-TeX-style-dir))
(member (substring preview-TeX-style-dir -1) '(";" ":")))
preview-TeX-style-dir
(let ((sep
(cond
((stringp TeX-kpathsea-path-delimiter)
TeX-kpathsea-path-delimiter)
((string-match
"\\`.[:]"
(if (file-name-absolute-p preview-TeX-style-dir)
preview-TeX-style-dir
(expand-file-name preview-TeX-style-dir)))
";")
(t ":"))))
(concat "." sep preview-TeX-style-dir sep))))
(defun preview-set-texinputs (&optional remove)
"Add `preview-TeX-style-dir' into `TEXINPUTS' variables.
With prefix argument REMOVE, remove it again."
(interactive "P")
(let ((case-fold-search nil)
(preview-TeX-style-dir (preview-TeX-style-cooked))
pattern)
(if remove
(progn
(setq pattern (concat "\\`\\(TEXINPUTS[^=]*\\)=\\(.*\\)"
(regexp-quote preview-TeX-style-dir)))
(dolist (env (copy-sequence process-environment))
(if (string-match pattern env)
(setenv (match-string 1 env)
(and (or (< (match-beginning 2) (match-end 2))
(< (match-end 0) (length env)))
(concat (match-string 2 env)
(substring env (match-end 0))))))))
(setq pattern (regexp-quote preview-TeX-style-dir))
(dolist (env (cons "TEXINPUTS=" (copy-sequence process-environment)))
(if (string-match "\\`\\(TEXINPUTS[^=]*\\)=" env)
(unless (save-match-data (string-match pattern env))
(setenv (match-string 1 env)
(concat preview-TeX-style-dir
(substring env (match-end 0))))))))))
(defcustom preview-TeX-style-dir nil
"This variable contains the location of uninstalled TeX styles.
If this is nil, the preview styles are considered to be part of
the installed TeX system.
Otherwise, it can either just specify an absolute directory, or
it can be a complete TEXINPUTS specification. If it is the
latter, it has to be followed by the character with which
kpathsea separates path components, either `:' on Unix-like
systems, or `;' on Windows-like systems. And it should be
preceded with .: or .; accordingly in order to have . first in
the search path.
The `TEXINPUTS' environment type variables will get this prepended
at load time calling \\[preview-set-texinputs] to reflect this.
You can permanently install the style files using
\\[preview-install-styles].
Don't set this variable other than with customize so that its
changes get properly reflected in the environment."
:group 'preview-latex
:set (lambda (var value)
(and (boundp var)
(symbol-value var)
(preview-set-texinputs t))
(set var value)
(and (symbol-value var)
(preview-set-texinputs)))
:type '(choice (const :tag "Installed" nil)
(string :tag "Style directory or TEXINPUTS path")))
;;;###autoload
(defun preview-install-styles (dir &optional force-overwrite
force-save)
"Installs the TeX style files into a permanent location.
This must be in the TeX search path. If FORCE-OVERWRITE is greater
than 1, files will get overwritten without query, if it is less
than 1 or nil, the operation will fail. The default of 1 for interactive
use will query.
Similarly FORCE-SAVE can be used for saving
`preview-TeX-style-dir' to record the fact that the uninstalled
files are no longer needed in the search path."
(interactive "DPermanent location for preview TeX styles
pp")
(unless preview-TeX-style-dir
(error "Styles are already installed"))
(dolist (file (or
(condition-case nil
(directory-files
(progn
(string-match
"\\`\\(\\.[:;]\\)?\\(.*?\\)\\([:;]\\)?\\'"
preview-TeX-style-dir)
(match-string 2 preview-TeX-style-dir))
t "\\.\\(sty\\|def\\|cfg\\)\\'")
(error nil))
(error "Can't find files to install")))
(copy-file file dir (cond ((eq force-overwrite 1) 1)
((numberp force-overwrite)
(> force-overwrite 1))
(t force-overwrite))))
(if (cond ((eq force-save 1)
(y-or-n-p "Stop using non-installed styles permanently "))
((numberp force-save)
(> force-save 1))
(t force-save))
(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)
(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.
This is called by `LaTeX-mode-hook' and changes AUCTeX variables
to add the preview functionality."
;; This has to be done only once.
(unless (and (boundp 'LaTeX-mode-hook)
(memq #'preview-mode-setup LaTeX-mode-hook))
(remove-hook 'LaTeX-mode-hook #'LaTeX-preview-setup)
(add-hook 'LaTeX-mode-hook #'preview-mode-setup)
(define-key LaTeX-mode-map "\C-c\C-p" preview-map)
(easy-menu-define preview-menu LaTeX-mode-map
"This is the menu for preview-latex."
'("Preview"
"Generate previews"
["(or toggle) at point" preview-at-point]
["for environment" preview-environment]
["for section" preview-section]
["for region" preview-region mark-active]
["for buffer" preview-buffer]
["for document" preview-document]
"---"
"Remove previews"
["at point" preview-clearout-at-point]
["from section" preview-clearout-section]
["from region" preview-clearout mark-active]
["from buffer" preview-clearout-buffer]
["from document" preview-clearout-document]
"---"
"Turn preamble cache"
["on" preview-cache-preamble]
["off" preview-cache-preamble-off]
"---"
("Customize"
["Browse options"
(customize-group 'preview)]
["Extend this menu"
(easy-menu-add-item
nil '("Preview")
(customize-menu-create 'preview))])
["Read documentation" preview-goto-info-page]
["Report Bug" preview-report-bug]))
(if (eq major-mode 'latex-mode)
(preview-mode-setup))
(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"
2022-11-08 03:31:08 +00:00
:vert-only t)))))
2022-08-25 17:42:37 +00:00
(defun preview-clean-subdir (dir)
"Cleans out a temporary DIR with preview image files."
(condition-case err
(progn
(mapc #'delete-file
(directory-files dir t "\\`pr" t))
(delete-directory dir))
(error (message "Deletion of `%s' failed: %s" dir
(error-message-string err)))))
(defun preview-clean-topdir (topdir)
"Cleans out TOPDIR from temporary directories.
This does not erase the directory itself since its permissions
might be needed for colloborative work on common files."
(mapc #'preview-clean-subdir
(condition-case nil
(directory-files topdir t "\\`tmp" t)
(file-error nil))))
(defun preview-create-subdirectory ()
"Create a temporary subdir for the current TeX process.
If necessary, generates a fitting top
directory or cleans out an existing one (if not yet
visited in this session), then returns the name of
the created subdirectory relative to the master directory,
in shell-quoted form. `TeX-active-tempdir' is
set to the corresponding TEMPDIR descriptor as described
in `preview-make-filename'. The directory is registered
in `preview-temp-dirs' in order not to be cleaned out
later while in use."
(let ((topdir (expand-file-name (TeX-active-master "prv"))))
(if (file-directory-p topdir)
(unless (member topdir preview-temp-dirs)
;; Cleans out the top preview directory by
;; removing subdirs possibly left from a previous session.
(preview-clean-topdir topdir)
(push topdir preview-temp-dirs))
(make-directory topdir)
(add-to-list 'preview-temp-dirs topdir))
(add-hook 'kill-emacs-hook #'preview-cleanout-tempfiles t)
(setq TeX-active-tempdir
(list (make-temp-file (expand-file-name
"tmp" (file-name-as-directory topdir)) t)
topdir
0))
(shell-quote-argument
(concat (file-name-as-directory
;; Don't use topdir, because %m expects the path to be
;; relative to master
(TeX-active-master "prv" t))
(file-name-nondirectory (nth 0 TeX-active-tempdir))))))
(defun preview-parse-counters (string)
"Extract counter information from STRING."
(let ((list preview-parsed-counters) (pos 0))
(while (eq pos (string-match " *\\({\\([^{}]+\\)}{[-0-9]+}\\)" string pos))
(setcdr (or (assoc (match-string 2 string) list)
(car (push (list (match-string 2 string)) list)))
(match-string 1 string))
(setq pos (match-end 1)))
list))
(defun preview-parse-tightpage (string)
"Build tightpage vector from STRING,"
(read (concat "[" string "]")))
(defvar preview-parse-variables
'(("Fontsize" preview-parsed-font-size
"\\` *\\([0-9.]+\\)pt\\'" 1 string-to-number)
("Magnification" preview-parsed-magnification
"\\` *\\([0-9]+\\)\\'" 1 string-to-number)
("PDFoutput" preview-parsed-pdfoutput
"" 0 stringp)
("Counters" preview-parsed-counters
".*" 0 preview-parse-counters)
("Tightpage" preview-parsed-tightpage
"\\` *\\(-?[0-9]+ *\\)\\{4\\}\\'" 0 preview-parse-tightpage)))
(defun preview-error-quote (string)
"Turn STRING with potential ^^ sequences into a regexp.
To preserve sanity, additional ^ prefixes are matched literally,
so the character represented by ^^^ preceding extended characters
will not get matched, usually."
(let (output case-fold-search)
;; Some coding systems (e.g. japanese-shift-jis) use regexp meta
;; characters on encoding. Such meta characters would be
;; interfered with `regexp-quote' below. Thus the idea of
;; "encoding entire string beforehand and decoding it at the last
;; stage" does not work for such coding systems.
;; Rather, we work consistently with decoded text.
;; Bytes with value from 0x80 to 0xFF represented with ^^ form are
;; converted to byte sequence, and decoded by the file coding
;; system.
(setq string
(preview--decode-^^ab string buffer-file-coding-system))
;; Then, control characters are taken into account.
(while (string-match "\\^\\{2,\\}\\([@-_?]\\)" string)
(setq output
(concat output
(regexp-quote (substring string
0
(- (match-beginning 1) 2)))
(concat
"\\(?:" (regexp-quote
(substring string
(- (match-beginning 1) 2)
(match-end 0)))
"\\|"
(char-to-string
(logxor (aref string (match-beginning 1)) 64))
"\\)"))
string (substring string (match-end 0))))
(setq output (concat output (regexp-quote string)))
output))
(defun preview--decode-^^ab (string coding-system)
"Decode ^^ sequences in STRING with CODING-SYSTEM.
Sequences of control characters such as ^^I are left untouched.
Return a new string."
;; Since the given string can contain multibyte characters, decoding
;; should be performed seperately on each segment made up entirely
;; with ASCII and raw 8-bit characters.
;; Raw 8-bit characters can arise if the latex outputs multibyte
;; characters with partial ^^-quoting.
(let ((result ""))
;; Here we want to collect all the ASCII and raw 8-bit bytes,
;; excluding proper multibyte characters. The regexp
;; [^[:multibyte:]]+ serves for that purpose. The alternative
;; [\x00-\xFF]+ does the job as well at least for emacs 24-26, so
;; use it instead if the former becomes invalid in future.
;; N.B. [[:unibyte:]]+ doesn't match raw 8-bit bytes, contrary to
;; naive expectation.
(while (string-match "[^[:multibyte:]]+" string)
(setq result
(concat result
(substring string 0 (match-beginning 0))
(let ((text
(save-match-data
(preview--convert-^^ab
(match-string 0 string)))))
(decode-coding-string text coding-system)))
string (substring string (match-end 0))))
(setq result (concat result string))
result))
(defun preview--convert-^^ab (string)
"Convert ^^ sequences in STRING to raw 8bit.
Sequences of control characters such as ^^I are left untouched.
Return a new string."
(let ((result ""))
(while (string-match "\\^\\^[8-9a-f][0-9a-f]" string)
(setq result
(concat result
(substring string 0 (match-beginning 0))
(let ((byte (string-to-number
(substring string
(+ (match-beginning 0) 2)
(match-end 0)) 16)))
(byte-to-string byte)))
string (substring string (match-end 0))))
(setq result (concat result string))
result))
(defun preview-parse-messages (open-closure)
"Turn all preview snippets into overlays.
This parses the pseudo error messages from the preview
document style for LaTeX. OPEN-CLOSURE is called once
it is certain that we have a valid output file, and it has
to return in its CAR the PROCESS parameter for the CLOSE
call, and in its CDR the final stuff for the placement hook."
(with-temp-message "locating previews..."
(let (TeX-error-file TeX-error-offset snippet box counters
file line
(lsnippet 0) lstart (lfile "") lline lbuffer lpoint
lcounters
string after-string
offset
parsestate (case-fold-search nil)
(run-buffer (current-buffer))
(run-directory default-directory)
tempdir
close-data
open-data
fast-hook
slow-hook
TeX-translate-location-file
TeX-translate-location-line
TeX-translate-location-error
TeX-translate-location-offset
TeX-translate-location-context
TeX-translate-location-string)
;; clear parsing variables
(dolist (var preview-parse-variables)
(set (nth 1 var) nil))
(goto-char (point-min))
(unwind-protect
(progn
(while
(re-search-forward "\
^\\(!\\|\\(.*?\\):[0-9]+:\\) \\|\
\(\\(/*\
\\(?:\\.+[^()\r\n{} /]*\\|[^()\r\n{} ./]+\
\\(?: [^()\r\n{} ./]+\\)*\\(?:\\.[-0-9a-zA-Z_.]*\\)?\\)\
\\(?:/+\\(?:\\.+[^()\r\n{} /]*\\|[^()\r\n{} ./]+\
\\(?: [^()\r\n{} ./]+\\)*\\(?:\\.[-0-9a-zA-Z_.]*\\)?\\)?\\)*\\)\
)*\\(?: \\|\r?$\\)\\|\
\\()+\\)\\|\
!\\(?:offset(\\([---0-9]+\\))\\|\
name(\\([^)]+\\))\\)\\|\
^Preview: \\([a-zA-Z]+\\) \\([^\n\r]*\\)\r?$" nil t)
;;; Ok, here is a line by line breakdown:
;;; match-alternative 1:
;;; error indicator for TeX error, either style.
;;; match-alternative 2:
;;; The same, but file-line-error-style, matching on file name.
;;; match-alternative 3:
;;; Too ugly to describe in detail. In short, we try to catch file
;;; names built from path components that don't contain spaces or
;;; other special characters once the file extension has started.
;;;
;;; Position for searching immediately after the file name so as to
;;; not miss closing parens or something.
;;; (match-string 3) is the file name.
;;; match-alternative 4:
;;; )+\( \|$\)
;;; a closing paren followed by the end of line or a space: a just
;;; closed file.
;;; match-alternative 5 (wrapped into one shy group with
;;; match-alternative 6, so that the match on first char is slightly
;;; faster):
;;; !offset(\([---0-9]+\))
;;; an AUCTeX offset message. (match-string 5) is the offset itself
;;; !name(\([^)]+\))
;;; an AUCTeX file name message. (match-string 6) is the file name
;;; TODO: Actually, the latter two should probably again match only
;;; after a space or newline, since that it what \message produces.
;;; disabled in prauctex.def:
;;; \(?:Ov\|Und\)erfull \\.*[0-9]*--[0-9]*
;;; \(?:.\{79\}
;;; \)*.*$\)\|
;;; This would have caught overfull box messages that consist of
;;; several lines of context all with 79 characters in length except
;;; of the last one. prauctex.def kills all such messages.
(setq file (match-string-no-properties 2))
(cond
((match-beginning 1)
(if (looking-at "\
\\(?:Preview\\|Package Preview Error\\): Snippet \\([---0-9]+\\) \\(started\\|ended\\(\
\\.? *(\\([---0-9]+\\)\\+\\([---0-9]+\\)x\\([---0-9]+\\))\\)?\\)\\.")
(progn
(when file
(unless TeX-error-file
(push nil TeX-error-file)
(push nil TeX-error-offset))
(unless (car TeX-error-offset)
(rplaca TeX-error-file file)))
(setq snippet (string-to-number (match-string 1))
box (unless
(string= (match-string 2) "started")
(if (match-string 4)
(mapcar #'(lambda (x)
(* (preview-get-magnification)
(string-to-number x)))
(list
(match-string 4)
(match-string 5)
(match-string 6)))
t))
counters (mapcar #'cdr preview-parsed-counters)
;; And the line number to position the cursor.
line (progn
(setq lpoint (point))
(end-of-line)
;;; variant 1: profiling seems to indicate the regexp-heavy solution
;;; to be favorable. Removing incomplete characters from the error
;;; context is an absolute nuisance.
(and (re-search-forward "\
^l\\.\\([0-9]+\\) \\(\\.\\.\\.\\(?:\\^*\\(?:[89a-f][0-9a-f]\\|[]@-\\_?]\\)\\|\
\[0-9a-f]?\\)\\)?\\([^\n\r]*?\\)\r?
\\([^\n\r]*?\\)\\(\\(?:\\^+[89a-f]?\\)?\\.\\.\\.\\)?\r?$" nil t)
(string-to-number (match-string 1))))
;; And a string of the context to search for.
string (and line (match-string 3))
after-string (and line (buffer-substring
(+ (match-beginning 4)
(- (match-end 3)
(match-beginning 0)))
(match-end 4)))
;; We may use these in another buffer.
offset (or (car TeX-error-offset) 0)
file (car TeX-error-file))
(when (and (stringp file)
(or (string= file "<none>")
(TeX-match-extension file)))
;; if we are the first time round, check for fast hooks:
(when (null parsestate)
(setq open-data
(save-excursion (funcall open-closure))
tempdir TeX-active-tempdir)
(dolist
(lst (if (listp TeX-translate-location-hook)
TeX-translate-location-hook
(list TeX-translate-location-hook)))
(let ((fast
(and (symbolp lst)
(get lst 'TeX-translate-via-list))))
(if fast
(setq fast-hook
(nconc fast-hook (list fast)))
(setq slow-hook
(nconc slow-hook (list lst)))))))
;; Functions in `TeX-translate-location-hook'
;; may examine and modify the following variables.
(setq TeX-translate-location-file file
TeX-translate-location-line line
;; TeX-translate-location-error error
TeX-translate-location-offset offset
;; TeX-translate-location-context context
TeX-translate-location-string string)
(condition-case err
(save-excursion (mapc #'funcall slow-hook))
(error (preview-log-error err "Translation hook")))
(setq file TeX-translate-location-file
line TeX-translate-location-line
;; error TeX-translate-location-error
offset TeX-translate-location-offset
;; context TeX-translate-location-context
string TeX-translate-location-string)
(push (vector file (+ line offset)
string after-string
snippet box counters)
parsestate)))
;; else normal error message
(forward-line)
(re-search-forward "^l\\.[0-9]" nil t)
(forward-line 2)))
((match-beginning 3)
;; New file -- Push on stack
(push (match-string-no-properties 3) TeX-error-file)
(push nil TeX-error-offset)
(goto-char (match-end 3)))
((match-beginning 4)
;; End of file -- Pop from stack
(when (> (length TeX-error-file) 1)
(pop TeX-error-file)
(pop TeX-error-offset))
(goto-char (1+ (match-beginning 0))))
((match-beginning 5)
;; Hook to change line numbers
(setq TeX-error-offset
(list (string-to-number (match-string 5)))))
((match-beginning 6)
;; Hook to change file name
(setq TeX-error-file (list (match-string-no-properties 6))))
((match-beginning 7)
(let ((var
(assoc (match-string-no-properties 7)
preview-parse-variables))
(offset (- (match-beginning 0) (match-beginning 8)))
(str (match-string-no-properties 8)))
;; paste together continuation lines:
(while (= (- (length str) offset) 79)
(search-forward-regexp "^\\([^\n\r]*\\)\r?$")
(setq offset (- (length str))
str (concat str (match-string-no-properties 1))))
(when (and var
(string-match (nth 2 var) str))
(set (nth 1 var)
(funcall (nth 4 var)
(match-string-no-properties
(nth 3 var)
str))))))))
(when (null parsestate)
(error "LaTeX found no preview images")))
(unwind-protect
(save-excursion
(setq parsestate (nreverse parsestate))
(condition-case err
(dolist (fun fast-hook)
(setq parsestate
(save-excursion (funcall fun parsestate))))
(error (preview-log-error err "Fast translation hook")))
(setq snippet 0)
(dolist (state parsestate)
(setq lsnippet snippet
file (aref state 0)
line (aref state 1)
string (aref state 2)
after-string (aref state 3)
snippet (aref state 4)
box (aref state 5)
counters (aref state 6))
(unless (string= lfile file)
(set-buffer (if (string= file "<none>")
(with-current-buffer run-buffer
TeX-command-buffer)
(find-file-noselect
(expand-file-name file run-directory))))
(setq lfile file))
(save-excursion
(save-restriction
(widen)
;; a fast hook might have positioned us already:
(if (number-or-marker-p string)
(progn
(goto-char string)
(setq lpoint
(if (number-or-marker-p after-string)
after-string
(line-beginning-position))))
(if (and (eq (current-buffer) lbuffer)
(<= lline line))
;; while Emacs does the perfectly correct
;; thing even when when the line differences
;; get zero or negative, I don't trust this
;; to be universally the case across other
;; implementations. Besides, if the line
;; number gets smaller again, we are probably
;; rereading the file, and restarting from
;; the beginning will probably be faster.
(progn
(goto-char lpoint)
(if (/= lline line)
(if (eq selective-display t)
(re-search-forward "[\n\C-m]" nil
'end
(- line lline))
(forward-line (- line lline)))))
(goto-char (point-min))
(forward-line (1- line)))
(setq lpoint (point))
(cond
((search-forward (concat string after-string)
(line-end-position) t)
(backward-char (length after-string)))
;;ok, transform ^^ sequences
((search-forward-regexp
(concat "\\("
(setq string
(preview-error-quote
string))
"\\)"
(setq after-string
(preview-error-quote
after-string)))
(line-end-position) t)
(goto-char (match-end 1)))
((search-forward-regexp
(concat "\\("
(if (string-match
"^[^\0-\177]\\{1,6\\}" string)
(setq string
(substring string (match-end 0)))
string)
"\\)"
(if (string-match
"[^\0-\177]\\{1,6\\}$" after-string)
(setq after-string
(substring after-string
0 (match-beginning 0)))))
(line-end-position) t)
(goto-char (match-end 1)))
(t (search-forward-regexp
string
(line-end-position) t))))
(setq lline line
lbuffer (current-buffer))
(if box
(progn
(if (and lstart (= snippet lsnippet))
(setq close-data
(nconc
(preview-place-preview
snippet
(save-excursion
(preview-back-command
(= (prog1 (point)
(goto-char lstart))
lstart))
(point))
(point)
(preview-TeX-bb box)
(cons lcounters counters)
tempdir
(cdr open-data))
close-data))
(with-current-buffer run-buffer
(preview-log-error
(list 'error
(format
"End of Preview snippet %d unexpected"
snippet)) "Parser")))
(setq lstart nil))
;; else-part of if box
(setq lstart (point) lcounters counters)
;; >= because snippets in between might have
;; been ignored because of TeX-default-extension
(unless (>= snippet (1+ lsnippet))
(with-current-buffer run-buffer
(preview-log-error
(list 'error
(format
"Preview snippet %d out of sequence"
snippet)) "Parser"))))))))
(preview-call-hook 'close (car open-data) close-data))))))
(defun preview-get-dpi ()
(let* ((monitor-attrs (frame-monitor-attributes))
(mm-dims (cdr (assoc 'mm-size monitor-attrs)))
(mm-width (nth 0 mm-dims))
(mm-height (nth 1 mm-dims))
(pixel-dims (cl-cdddr (assoc 'geometry monitor-attrs)))
(pixel-width (nth 0 pixel-dims))
(pixel-height (nth 1 pixel-dims)))
(cons (/ (* 25.4 pixel-width) mm-width)
(/ (* 25.4 pixel-height) mm-height))))
2022-08-25 17:42:37 +00:00
(defun preview-get-geometry ()
"Transfer display geometry parameters from current display.
Return list of scale, resolution and colors. Calculation
is done in current buffer."
(condition-case err
(let* ((geometry
(list (preview-hook-enquiry preview-scale-function)
(preview-get-dpi)
(preview-get-colors)))
(preview-min-spec
(* (cdr (nth 1 geometry))
(/
(preview-inherited-face-attribute
'preview-reference-face :height 'default)
720.0))))
(setq preview-icon (preview-make-image 'preview-icon-specs)
preview-error-icon (preview-make-image
'preview-error-icon-specs)
preview-nonready-icon (preview-make-image
'preview-nonready-icon-specs))
geometry)
(error (error "Display geometry unavailable: %s"
(error-message-string err)))))
(defun preview-set-geometry (geometry)
"Set geometry variables from GEOMETRY.
Buffer-local `preview-scale', `preview-resolution',
and `preview-colors' are set as given."
(setq preview-scale (nth 0 geometry)
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)
tempdir
(res (/ (* (car preview-resolution)
(preview-hook-enquiry preview-scale))
(preview-get-magnification)))
(resolution (format " -D%d " res))
(colors (preview-dvipng-color-string preview-colors res))
(command (with-current-buffer TeX-command-buffer
(prog1
(concat (TeX-command-expand preview-dvipng-command)
" " colors resolution)
(setq tempdir TeX-active-tempdir))))
(name "Preview-DviPNG"))
(setq TeX-active-tempdir tempdir)
(goto-char (point-max))
(insert-before-markers "Running `" name "' with ``" command "''\n")
(setq mode-name name)
(setq TeX-sentinel-function
(lambda (_process name) (message "%s: done." name)))
(if TeX-process-asynchronous
(let ((process (start-process name (current-buffer) TeX-shell
TeX-shell-command-option
command)))
(if TeX-after-start-process-function
(funcall TeX-after-start-process-function process))
(TeX-command-mode-line process)
(set-process-filter process #'TeX-command-filter)
(set-process-sentinel process #'TeX-command-sentinel)
(set-marker (process-mark process) (point-max))
(push process compilation-in-progress)
(sit-for 0)
process)
(setq mode-line-process ": run")
(force-mode-line-update)
(call-process TeX-shell nil (current-buffer) nil
TeX-shell-command-option
command))))
(defun preview-start-dvips (&optional fast)
"Start a DviPS process.
If FAST is set, do a fast conversion."
(let* (;; (file preview-gs-file)
tempdir
(command (with-current-buffer TeX-command-buffer
(prog1
(TeX-command-expand (if fast
preview-fast-dvips-command
preview-dvips-command))
(setq tempdir TeX-active-tempdir))))
(name "Preview-DviPS"))
(setq TeX-active-tempdir tempdir)
(setq preview-ps-file (and fast
(preview-make-filename
(preview-make-filename
"preview.ps" tempdir)
tempdir)))
(goto-char (point-max))
(insert-before-markers "Running `" name "' with ``" command "''\n")
(setq mode-name name)
(setq TeX-sentinel-function
(lambda (_process name) (message "%s: done." name)))
(if TeX-process-asynchronous
(let ((process (start-process name (current-buffer) TeX-shell
TeX-shell-command-option
command)))
(if TeX-after-start-process-function
(funcall TeX-after-start-process-function process))
(TeX-command-mode-line process)
(set-process-filter process #'TeX-command-filter)
(set-process-sentinel process #'TeX-command-sentinel)
(set-marker (process-mark process) (point-max))
(push process compilation-in-progress)
(sit-for 0)
process)
(setq mode-line-process ": run")
(force-mode-line-update)
(call-process TeX-shell nil (current-buffer) nil
TeX-shell-command-option
command))))
(defun preview-start-pdf2dsc ()
"Start a PDF2DSC process."
(let* ((file preview-gs-file)
tempdir
pdfsource
(command (with-current-buffer TeX-command-buffer
(prog1
(TeX-command-expand preview-pdf2dsc-command)
(setq tempdir TeX-active-tempdir
pdfsource (funcall (car file) "pdf" t)))))
(name "Preview-PDF2DSC"))
(setq TeX-active-tempdir tempdir)
(setq preview-ps-file (preview-attach-filename
pdfsource
(preview-make-filename
(preview-make-filename
"preview.dsc" tempdir)
tempdir)))
(goto-char (point-max))
(insert-before-markers "Running `" name "' with ``" command "''\n")
(setq mode-name name)
(setq TeX-sentinel-function
(lambda (_process name) (message "%s: done." name)))
(if TeX-process-asynchronous
(let ((process (start-process name (current-buffer) TeX-shell
TeX-shell-command-option
command)))
(if TeX-after-start-process-function
(funcall TeX-after-start-process-function process))
(TeX-command-mode-line process)
(set-process-filter process #'TeX-command-filter)
(set-process-sentinel process #'TeX-command-sentinel)
(set-marker (process-mark process) (point-max))
(push process compilation-in-progress)
(sit-for 0)
process)
(setq mode-line-process ": run")
(force-mode-line-update)
(call-process TeX-shell nil (current-buffer) nil
TeX-shell-command-option
command))))
(defun preview-TeX-inline-sentinel (process _name)
"Sentinel function for preview.
See `TeX-sentinel-function' and `set-process-sentinel'
for definition of PROCESS and NAME."
(if process (TeX-format-mode-line process))
(let ((status (process-status process)))
(if (memq status '(signal exit))
(delete-process process))
(when (eq status 'exit)
(save-excursion
(goto-char (point-max))
(forward-line -1)
(if (search-forward "abnormally with code 1" nil t)
(replace-match "as expected with code 1" t t)
(if (search-forward "finished" nil t)
(insert " with nothing to show"))))
(condition-case err
(preview-call-hook 'open)
(error (preview-log-error err "LaTeX" process)))
(preview-reraise-error process))))
(defcustom preview-format-extensions '(".fmt" ".efmt")
"Possible extensions for format files.
Those are just needed for cleanup."
:group 'preview-latex
:type '(repeat string))
(defun preview-format-kill (format-cons)
"Kill a cached format.
FORMAT-CONS is intended to be an element of `preview-dumped-alist'.
Tries through `preview-format-extensions'."
(dolist (ext preview-format-extensions)
(condition-case nil
(delete-file (preview-dump-file-name (concat (car format-cons) ext)))
(file-error nil))))
(defun preview-dump-file-name (file)
"Make a file name suitable for dumping from FILE."
(if file
(concat (file-name-directory file)
"prv_"
(progn
(setq file (file-name-nondirectory file))
(while (string-match " " file)
(setq file (replace-match "_" t t file)))
file))
"prv_texput"))
(defun preview-do-replacements (string replacements)
"Perform replacements in string.
STRING is the input string, REPLACEMENTS is a list of replacements.
A replacement is a cons-cell, where the car is the match string,
and the cdr is a list of strings or symbols. Symbols get dereferenced,
and strings get evaluated as replacement strings."
(let (rep case-fold-search)
(while replacements
(setq rep (pop replacements))
(cond ((symbolp rep)
(setq string (preview-do-replacements
string (symbol-value rep))))
((string-match (car rep) string)
(setq string
(mapconcat (lambda(x)
(if (symbolp x)
(symbol-value x)
(replace-match x t nil string)))
(cdr rep) ""))))))
string)
(defconst preview-LaTeX-disable-pdfoutput
'(("\\`\\(pdf[^ ]*\\)\
\\(\\( +[-&]\\([^ \"]\\|\"[^\"]*\"\\)*\\|\
+\"[-&][^\"]*\"\\)*\\)\\(.*\\)\\'"
. ("\\1\\2 \"\\\\pdfoutput=0 \" \\5")))
"This replacement places `\"\\pdfoutput=0 \"' after the options
of any command starting with `pdf'.")
(defcustom preview-LaTeX-command-replacements
nil
"Replacement for `preview-LaTeX-command'.
This is passed through `preview-do-replacements'."
:group 'preview-latex
:type '(repeat
(choice
(symbol :tag "Named replacement" :value preview-LaTeX-disable-pdfoutput)
(cons (string :tag "Matched string")
(repeat :tag "Concatenated elements for replacement"
(choice (symbol :tag "Variable with literal string")
(string :tag "non-literal regexp replacement")))))))
(defvar preview-format-name nil
"Format name when enabling preamble cache.")
(defcustom preview-dump-replacements
'(preview-LaTeX-command-replacements
;; If -kanji option exists, pick it up as the second match.
;; Discard all other options.
("\\`\\([^ ]+\\)\
\\(?: +\\(?:\\(--?kanji[= ][^ ]+\\)\\|\\(--?output-directory[= ][^ ]+\\)\\|-\\(?:[^ \\\"]\\|\\\\.\\|\"[^\"]*\"\\)*\\)\\)*\\(.*\\)\\'"
. ("\\1 -ini \\2 \\3 -interaction=nonstopmode \"&\\1\" " preview-format-name ".ini \\4")))
"Generate a dump command from the usual preview command."
:group 'preview-latex
:type '(repeat
(choice (symbol :tag "Named replacement")
(cons string (repeat (choice symbol string))))))
(defcustom preview-undump-replacements
;; If -kanji option exists, pick it up as the second match.
;; Discard all other options.
'(("\\`\\([^ ]+\\)\
\\(?: +\\(?:\\(--?kanji[= ][^ ]+\\)\\|\\(--?output-directory[= ][^ ]+\\)\\|-\\(?:[^ \\\"]\\|\\\\.\\|\"[^\"]*\"\\)*\\)\\)*.*\
\"\\\\input\" \"\\\\detokenize{\" \\(.*\\) \"}\"\\'"
. ("\\1 \\2 \\3 -interaction=nonstopmode -file-line-error "
preview-format-name " \"/AUCTEXINPUT{\" \\4 \"}\"")))
;; See the ini file code below in `preview-cache-preamble' for the
;; weird /AUCTEXINPUT construct. In short, it is crafted so that
;; dumped format file can read file of non-ascii name.
"Use a dumped format for reading preamble."
:group 'preview-latex
:type '(repeat
(choice (symbol :tag "Named replacement")
(cons string (repeat (choice symbol string))))))
(defun preview-cache-preamble (&optional format-cons)
"Dump a pregenerated format file.
For the rest of the session, this file is used when running
on the same master file.
Return the process for dumping, nil if there is still a valid
format available.
If FORMAT-CONS is non-nil, a previous format may get reused."
(interactive)
(setq TeX-current-process-region-p nil)
(let* ((dump-file
(expand-file-name (preview-dump-file-name (TeX-master-file "ini"))))
(master (TeX-master-file))
(format-name (expand-file-name master))
(preview-format-name (shell-quote-argument
(preview-dump-file-name (file-name-nondirectory
master))))
(master-file (expand-file-name (TeX-master-file t)))
(command (preview-do-replacements
(TeX-command-expand
(preview-string-expand preview-LaTeX-command))
preview-dump-replacements))
(preview-auto-cache-preamble nil))
(unless (and (consp (cdr format-cons))
(string= command (cadr format-cons)))
(unless format-cons
(setq format-cons (assoc format-name preview-dumped-alist)))
(if format-cons
(preview-cache-preamble-off format-cons)
(setq format-cons (list format-name))
(push format-cons preview-dumped-alist))
2022-11-08 03:31:08 +00:00
;; mylatex.ltx expects a file name to follow. Bad.
;; The file `.tex' in the tools bundle is solely emitting
;; `File ignored', and `\input mylatex.ltx \relax' has the
;; same effect as `\input mylatex.ltx .tex '.
;; The \dump hacks accomplish, among others:
;; - let TeX not ignore spaces (despite instructions to the
;; contrary inserted into the format by mylatex.ltx)
;; as we may need to input a `file name with spaces'.
;; - work around the fact that the backslash `\' (as per
;; mylatex.ltx mandate) has lost its standard TeX status
;; once the format is loaded, and we could not use `\input'
;; as in e.g. `pdflatex &abc '\input' abc.tex'. We
;; configure TeX for `/' as substitute.
;; - in place of such `/input', we will use `/AUCTEXINPUT'
;; defined here in the dumped format to grab the file name,
;; sanitize it via `\detokenize', then
;; reset TeX to ignore spaces and execute `\input' which
;; will skip the preamble already dumped.
;; Prior to the patch adding `/AUCTEXINPUT', resetting the
;; spaces to be ignored was included as part of `\everyjob',
;; which was another way to delay this to after the filename
;; was seen by TeX.
2022-08-25 17:42:37 +00:00
(write-region "\\let\\PREVIEWdump\\dump\\def\\dump{%
\\edef\\next{{\\ifx\\pdfoutput\\undefined\\else\
\\pdfoutput=\\the\\pdfoutput\\relax\\fi\
\\the\\everyjob}}\\everyjob\\next\\catcode`\\ 10 %
\\catcode`/ 0 %
\\def\\AUCTEXINPUT##1{\\catcode`/ 12\\relax\\catcode`\\ 9\\relax\\input\\detokenize{##1}\\relax}%
\\let\\dump\\PREVIEWdump\\dump}\\input mylatex.ltx \\relax%\n" nil dump-file)
(TeX-save-document #'TeX-master-file)
(prog1 (preview-generate-preview master command)
(add-hook 'kill-emacs-hook #'preview-cleanout-tempfiles t)
(setq TeX-sentinel-function
(lambda (process _status)
(condition-case err
(progn
(if (and (eq (process-status process) 'exit)
(zerop (process-exit-status process)))
(preview-watch-preamble
master-file
command
format-cons)
(preview-format-kill format-cons))
(delete-file dump-file))
(error (preview-log-error err "Dumping" process)))
(preview-reraise-error process)))))))
(defun preview-cache-preamble-off (&optional old-format)
"Clear the pregenerated format file.
The use of the format file is discontinued.
OLD-FORMAT may already contain a format-cons as
stored in `preview-dumped-alist'."
(interactive)
(unless old-format
(setq old-format
(let ((master-file (expand-file-name (TeX-master-file))))
(or (assoc master-file preview-dumped-alist)
(car (push (list master-file) preview-dumped-alist))))))
(preview-unwatch-preamble old-format)
(preview-format-kill old-format)
(setcdr old-format nil))
(defun preview-region (begin end)
"Run preview on region between BEGIN and END."
(interactive "r")
(let ((TeX-region-extra
;; Write out counter information to region.
(concat (preview--counter-information begin)
TeX-region-extra)))
(TeX-region-create (TeX-region-file TeX-default-extension)
(buffer-substring-no-properties begin end)
(if buffer-file-name
(file-name-nondirectory buffer-file-name)
"<none>")
(TeX-current-offset begin)))
(setq TeX-current-process-region-p t)
(preview-generate-preview (TeX-region-file)
(preview-do-replacements
(TeX-command-expand
(preview-string-expand preview-LaTeX-command))
preview-LaTeX-command-replacements)))
(defun preview-buffer ()
"Run preview on current buffer."
(interactive)
(preview-region (point-min) (point-max)))
;; We have a big problem: When we are dumping preambles, diagnostics
;; issued in later runs will not make it to the output when the
;; predumped format skips the preamble. So we have to place those
;; after \begin{document}. This we can only do if regions never
;; include the preamble. We could do this in our own functions, but
;; that would not extend to the operation of C-c C-r g RET. So we
;; make this preamble skipping business part of TeX-region-create.
;; This will fail if the region is to contain just part of the
;; preamble -- a bad idea anyhow.
(defun preview--skip-preamble-region (region-text region-offset)
"Skip preamble for the sake of predumped formats.
Helper function of `TeX-region-create'.
If REGION-TEXT doesn't contain preamble, it returns nil.
Otherwise, it returns cons (ALTERED-TEXT . ALTERED-OFFSET) where
ALTERED-TEXT is REGION-TEXT without the preamble part and
ALTERED-OFFSET is REGION-OFFSET increased by the number of lines
of the preamble part of REGION-TEXT."
(if (string-match TeX-header-end region-text)
(cons (substring region-text (match-end 0))
(with-temp-buffer
(insert (substring region-text 0 (match-end 0)))
(+ region-offset (TeX-current-offset))))))
(defun preview-document ()
"Run preview on master document."
(interactive)
(TeX-save-document #'TeX-master-file)
(setq TeX-current-process-region-p nil)
(preview-generate-preview
(TeX-master-file)
(preview-do-replacements
(TeX-command-expand
(preview-string-expand preview-LaTeX-command))
preview-LaTeX-command-replacements)))
(defun preview-environment (count)
"Run preview on LaTeX environment.
This avoids running environments through preview that are
indicated in `preview-inner-environments'. If you use a prefix
argument COUNT, the corresponding level of outward nested
environments is selected."
(interactive "p")
(save-excursion
(let (currenv)
(dotimes (_ (1- count))
(setq currenv (LaTeX-current-environment))
(if (string= currenv "document")
(error "No enclosing outer environment found"))
(LaTeX-find-matching-begin))
(while (member (setq currenv (LaTeX-current-environment))
preview-inner-environments)
(LaTeX-find-matching-begin))
(if (string= currenv "document")
(error "No enclosing outer environment found"))
(preview-region
(save-excursion (LaTeX-find-matching-begin) (point))
(save-excursion (LaTeX-find-matching-end) (point))))))
(defun preview-section ()
"Run preview on LaTeX section." (interactive)
(save-excursion
(LaTeX-mark-section)
(preview-region (region-beginning) (region-end))))
(defun preview-generate-preview (file command)
"Generate a preview.
FILE the file (without default extension), COMMAND is the command
to use.
It returns the started process."
(let* ((geometry (preview-get-geometry))
(commandbuff (current-buffer))
(pr-file (cons
#'TeX-active-master
(file-name-nondirectory file)))
(master (TeX-master-file))
(master-file (expand-file-name master))
(dumped-cons (assoc master-file
preview-dumped-alist))
process)
(unless dumped-cons
(push (setq dumped-cons (cons master-file
(if (eq preview-auto-cache-preamble 'ask)
(y-or-n-p "Cache preamble? ")
preview-auto-cache-preamble)))
preview-dumped-alist))
(when (cdr dumped-cons)
(let* (TeX-current-process-region-p)
(setq process (preview-cache-preamble dumped-cons))
(if process
;; FIXME: Use `add-function'.
(setq TeX-sentinel-function
(let ((prev-fun TeX-sentinel-function))
(lambda (process string)
(funcall prev-fun process string)
(TeX-inline-preview-internal
command file
pr-file commandbuff
dumped-cons
master
geometry
(buffer-string))))))))
(or process
(TeX-inline-preview-internal command file
pr-file commandbuff
dumped-cons master
geometry))))
(defun TeX-inline-preview-internal (command file pr-file
commandbuff dumped-cons _master
geometry
&optional str)
"Internal stuff for previewing.
COMMAND and FILE should be explained in `TeX-command-list'.
PR-FILE is the target file name in the form for `preview-gs-file'.
COMMANDBUFF, DUMPED-CONS, MASTER, and GEOMETRY are
internal parameters, STR may be a log to insert into the current log."
(set-buffer commandbuff)
(let*
((preview-format-name (shell-quote-argument
(concat "&"
(preview-dump-file-name
;; Get the filename from
;; `TeX-master-file' with prv to
;; get the correct path but then
;; strip the extension
(file-name-sans-extension
(TeX-master-file "prv" t))))))
(process-environment (copy-sequence process-environment))
(process
(progn
;; Fix Bug#20773, Bug#27088.
;; Make LaTeX not to insert newline in lines necessary to
;; identify Bounding Boxes.
(setenv "max_print_line" "1000")
(TeX-run-command
"Preview-LaTeX"
(if (consp (cdr dumped-cons))
(preview-do-replacements
command
preview-undump-replacements)
command)
file))))
(condition-case err
(progn
(when str
(save-excursion
(goto-char (point-min))
(insert str)
(when (= (process-mark process) (point-min))
(set-marker (process-mark process) (point)))))
(preview-set-geometry geometry)
(setq preview-gs-file pr-file)
(setq TeX-sentinel-function #'preview-TeX-inline-sentinel)
(TeX-parse-reset)
(setq TeX-parse-function #'TeX-parse-TeX)
(if TeX-process-asynchronous
process
(TeX-synchronous-sentinel "Preview-LaTeX" file process)))
(error (preview-log-error err "Preview" process)
(delete-process process)
(preview-reraise-error process)))))
(defconst preview-version AUCTeX-version
"Preview version.
If not a regular release, the date of the last change.")
(defconst preview-release-date AUCTeX-date
"Preview release date using the ISO 8601 format, yyyy-mm-dd.")
(defun preview-dump-state (buffer)
(condition-case nil
(progn
(unless (local-variable-p 'TeX-command-buffer (current-buffer))
(setq buffer (with-current-buffer buffer (TeX-active-buffer))))
(when (bufferp buffer)
(insert "\nRun buffer contents:\n\n")
(if (< (buffer-size buffer) 5000)
(insert-buffer-substring buffer)
(insert-buffer-substring buffer 1 2500)
(insert "...\n\n[...]\n\n\t...")
(insert-buffer-substring buffer
(- (buffer-size buffer) 2500)
(buffer-size buffer)))
(insert "\n")))
(error nil)))
;;;###autoload
(defun preview-report-bug () "Report a bug in the preview-latex package."
(interactive)
(let ((reporter-prompt-for-summary-p "Bug report subject: "))
(reporter-submit-bug-report
"bug-auctex@gnu.org"
preview-version
'(AUCTeX-version
LaTeX-command-style
image-types
preview-image-type
preview-image-creators
preview-dvipng-image-type
preview-dvipng-command
preview-pdf2dsc-command
preview-gs-command
preview-gs-options
preview-gs-image-type-alist
preview-fast-conversion
preview-prefer-TeX-bb
preview-dvips-command
preview-fast-dvips-command
preview-scale-function
preview-LaTeX-command
preview-required-option-list
preview-preserve-counters
preview-default-option-list
preview-default-preamble
preview-LaTeX-command-replacements
preview-dump-replacements
preview-undump-replacements
preview-auto-cache-preamble
preview-TeX-style-dir)
(let ((buf (current-buffer)))
(lambda () (preview-dump-state buf)))
(lambda ()
(insert (format "\nOutput from running `%s -h':\n"
preview-gs-command))
(call-process preview-gs-command nil t nil "-h")
(insert "\n"))
"Remember to cover the basics. Including a minimal LaTeX example
file exhibiting the problem might help."
)))
(provide 'preview)
;;; preview.el ends here