diff options
Diffstat (limited to 'elpa/auctex-13.1.3/preview.el')
| -rw-r--r-- | elpa/auctex-13.1.3/preview.el | 4288 |
1 files changed, 4288 insertions, 0 deletions
diff --git a/elpa/auctex-13.1.3/preview.el b/elpa/auctex-13.1.3/preview.el new file mode 100644 index 0000000..ad48b09 --- /dev/null +++ b/elpa/auctex-13.1.3/preview.el @@ -0,0 +1,4288 @@ +;;; 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)))))))) + +(eval-after-load "desktop" + '(add-hook + 'desktop-buffer-misc-functions + #'desktop-buffer-preview-misc-data)) + +(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)))))) + +(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)))) + +(eval-after-load "desktop" + '(if (boundp 'desktop-buffer-mode-handlers) + (add-to-list 'desktop-buffer-mode-handlers + '(latex-mode . desktop-buffer-preview)) + (defvar desktop-buffer-file-name) + (defvar desktop-buffer-name) + (defvar desktop-buffer-misc) + (add-hook 'desktop-buffer-handlers (lambda () + (desktop-buffer-preview + desktop-buffer-file-name + desktop-buffer-name + desktop-buffer-misc))))) + +(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))) + (if (boundp 'desktop-buffer-misc) + (preview-buffer-restore desktop-buffer-misc)))) + +(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 () + ;; TODO: Remove false-case when required emacs version is bumped to + ;; 24.4 or newer as this is the version where + ;; `frame-monitor-attributes' has been introduced. + (if (fboundp 'frame-monitor-attributes) + (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 (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))) + (cons (/ (* 25.4 (display-pixel-width)) + (display-mm-width)) + (/ (* 25.4 (display-pixel-height)) + (display-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. `.tex' + ;; in the tools bundle is an empty file. + (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 |