4297 lines
178 KiB
EmacsLisp
4297 lines
178 KiB
EmacsLisp
;;; 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.
|
|
Fallback to :inherit and \\='default implemented."
|
|
: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
|
|
the heuristic-mask setting of images to default to t since
|
|
then the borders are correctly detected even in case of
|
|
palette operations. If the transparent color is something
|
|
not present otherwise in the image, the cursor display
|
|
will affect just this border. A width of 0 is interpreted
|
|
by PostScript as meaning a single pixel, other widths are
|
|
interpreted as PostScript points (1/72 of 1in)."
|
|
:group 'preview-appearance
|
|
:type '(choice (const :value nil :tag "No border")
|
|
(number :value 1.5 :tag "Border width in pt")))
|
|
|
|
(defun preview-get-heuristic-mask ()
|
|
"Get heuristic-mask to use for previews.
|
|
Consults `preview-transparent-color'."
|
|
(cond ((stringp preview-transparent-color)
|
|
(color-values preview-transparent-color))
|
|
((or (not (consp preview-transparent-color))
|
|
(integerp (car preview-transparent-color)))
|
|
preview-transparent-color)
|
|
(t (color-values (preview-inherited-face-attribute
|
|
(nth 0 preview-transparent-color)
|
|
(nth 1 preview-transparent-color)
|
|
'default)))))
|
|
|
|
(defsubst preview-create-icon-1 (file type ascent border)
|
|
`(image
|
|
:file ,file
|
|
:type ,type
|
|
:ascent ,ascent
|
|
,@(and border
|
|
'(:mask (heuristic t)))))
|
|
|
|
(defun preview-create-icon (file type ascent border)
|
|
"Create an icon from FILE, image TYPE, ASCENT and BORDER."
|
|
(list
|
|
(preview-create-icon-1 file type ascent border)
|
|
file type ascent border))
|
|
|
|
(put 'preview-filter-specs :type
|
|
(lambda (_keyword value &rest args)
|
|
(if (image-type-available-p value)
|
|
`(image :type ,value
|
|
,@(preview-filter-specs-1 args))
|
|
(throw 'preview-filter-specs nil))))
|
|
|
|
(defun preview-import-image (image)
|
|
"Convert the printable IMAGE rendition back to an image."
|
|
(cond ((stringp image)
|
|
(propertize image 'face 'preview-face))
|
|
((eq (car image) 'image)
|
|
image)
|
|
(t
|
|
(preview-create-icon-1 (nth 0 image)
|
|
(nth 1 image)
|
|
(nth 2 image)
|
|
(if (< (length image) 4)
|
|
(preview-get-heuristic-mask)
|
|
(nth 3 image))))))
|
|
|
|
;; No defcustom here: does not seem to make sense.
|
|
|
|
(defvar preview-tb-icon-specs
|
|
'((:type xpm :file "prvtex24.xpm")
|
|
(:type xbm :file "prvtex24.xbm")))
|
|
|
|
(defvar preview-tb-icon nil)
|
|
|
|
(defun preview-add-urgentization (fun ov &rest rest)
|
|
"Cause FUN (function call form) to be called when redisplayed.
|
|
FUN must be a form with OV as first argument,
|
|
REST as the remainder, returning T."
|
|
(let ((dispro (overlay-get ov 'display)))
|
|
(unless (eq (car dispro) 'when)
|
|
(overlay-put ov 'display `(when (,fun ,ov ,@rest) . ,dispro)))))
|
|
|
|
(defun preview-remove-urgentization (ov)
|
|
"Undo urgentization of OV by `preview-add-urgentization'.
|
|
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,
|
|
nil displays the underlying text, and `toggle' toggles.
|
|
If EVENT is given, it indicates the window where the event
|
|
occured, either by being a mouse event or by directly being
|
|
the window in question. This may be used for cursor restoration
|
|
purposes."
|
|
(let ((old-urgent (preview-remove-urgentization ov))
|
|
(preview-state
|
|
(if (if (eq arg 'toggle)
|
|
(null (eq (overlay-get ov 'preview-state) 'active))
|
|
arg)
|
|
'active
|
|
'inactive))
|
|
(strings (overlay-get ov 'strings)))
|
|
(unless (eq (overlay-get ov 'preview-state) 'disabled)
|
|
(overlay-put ov 'preview-state preview-state)
|
|
(if (eq preview-state 'active)
|
|
(progn
|
|
(overlay-put ov 'category 'preview-overlay)
|
|
(if (eq (overlay-start ov) (overlay-end ov))
|
|
(overlay-put ov 'before-string (car strings))
|
|
(dolist (prop '(display keymap mouse-face help-echo))
|
|
(overlay-put ov prop
|
|
(get-text-property 0 prop (car strings))))
|
|
(overlay-put ov 'before-string nil))
|
|
(overlay-put ov 'face nil))
|
|
(dolist (prop '(display keymap mouse-face help-echo))
|
|
(overlay-put ov prop nil))
|
|
(overlay-put ov 'face 'preview-face)
|
|
(unless (cdr strings)
|
|
(setcdr strings (preview-inactive-string ov)))
|
|
(overlay-put ov 'before-string (cdr strings)))
|
|
(if old-urgent
|
|
(apply #'preview-add-urgentization old-urgent))))
|
|
(if event
|
|
(preview-restore-position
|
|
ov
|
|
(if (windowp event)
|
|
event
|
|
(posn-window (event-start event))))))
|
|
|
|
(defvar preview-marker (make-marker)
|
|
"Marker for fake intangibility.")
|
|
|
|
(defvar preview-temporary-opened nil)
|
|
|
|
(defvar preview-last-location nil
|
|
"Restored cursor position marker for reopened previews.")
|
|
(make-variable-buffer-local 'preview-last-location)
|
|
|
|
(defun preview-mark-point ()
|
|
"Mark position for fake intangibility."
|
|
(when (eq (get-char-property (point) 'preview-state) 'active)
|
|
(unless preview-last-location
|
|
(setq preview-last-location (make-marker)))
|
|
(set-marker preview-last-location (point))
|
|
(set-marker preview-marker (point))
|
|
(preview-move-point))
|
|
(set-marker preview-marker (point)))
|
|
|
|
(defun preview-restore-position (ov window)
|
|
"Tweak position after opening/closing preview.
|
|
The treated overlay OV has been triggered in WINDOW. This function
|
|
records the original buffer position for reopening, or restores it
|
|
after reopening. Note that by using the mouse, you can open/close
|
|
overlays not in the active window."
|
|
(when (eq (overlay-buffer ov) (window-buffer window))
|
|
(with-current-buffer (overlay-buffer ov)
|
|
(if (eq (overlay-get ov 'preview-state) 'active)
|
|
(setq preview-last-location
|
|
(set-marker (or preview-last-location (make-marker))
|
|
(window-point window)))
|
|
(when (and
|
|
(markerp preview-last-location)
|
|
(eq (overlay-buffer ov) (marker-buffer preview-last-location))
|
|
(< (overlay-start ov) preview-last-location)
|
|
(> (overlay-end ov) preview-last-location))
|
|
(set-window-point window preview-last-location))))))
|
|
|
|
(defun preview-move-point ()
|
|
"Move point out of fake-intangible areas."
|
|
(preview-check-changes)
|
|
(let* (newlist (pt (point)) (lst (overlays-at pt)) distance)
|
|
(setq preview-temporary-opened
|
|
(dolist (ov preview-temporary-opened newlist)
|
|
(and (overlay-buffer ov)
|
|
(eq (overlay-get ov 'preview-state) 'inactive)
|
|
(if (and (eq (overlay-buffer ov) (current-buffer))
|
|
(or (<= pt (overlay-start ov))
|
|
(>= pt (overlay-end ov))))
|
|
(preview-toggle ov t)
|
|
(push ov newlist)))))
|
|
(when lst
|
|
(if (or disable-point-adjustment
|
|
global-disable-point-adjustment
|
|
(preview-auto-reveal-p
|
|
preview-auto-reveal
|
|
(setq distance
|
|
(and (eq (marker-buffer preview-marker)
|
|
(current-buffer))
|
|
(- pt (marker-position preview-marker))))))
|
|
(preview-open-overlays lst)
|
|
(while lst
|
|
(setq lst
|
|
(if (and
|
|
(eq (overlay-get (car lst) 'preview-state) 'active)
|
|
(> pt (overlay-start (car lst))))
|
|
(overlays-at
|
|
(setq pt (if (and distance (< distance 0))
|
|
(overlay-start (car lst))
|
|
(overlay-end (car lst)))))
|
|
(cdr lst))))
|
|
(goto-char pt)))))
|
|
|
|
(defun preview-open-overlays (list &optional pos)
|
|
"Open all previews in LIST, optionally restricted to enclosing POS."
|
|
(dolist (ovr list)
|
|
(when (and (eq (overlay-get ovr 'preview-state) 'active)
|
|
(or (null pos)
|
|
(and
|
|
(> pos (overlay-start ovr))
|
|
(< pos (overlay-end ovr)))))
|
|
(preview-toggle ovr)
|
|
(push ovr preview-temporary-opened))))
|
|
|
|
(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))))))
|
|
|
|
;; 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
|
|
(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))))
|
|
|
|
;;;###autoload
|
|
(add-to-list 'desktop-buffer-mode-handlers
|
|
'(latex-mode . desktop-buffer-preview))
|
|
|
|
(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"
|
|
:vert-only t)))))
|
|
|
|
(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))))
|
|
|
|
(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))
|
|
;; 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.
|
|
(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
|