cgit.sxemacs.org Git - packages/blob - xemacs-packages/auctex/preview/preview.el

   1 ;;; preview.el --- embed preview LaTeX images in source buffer
   2
   3 ;; Copyright (C) 2001-2006, 2010-2014  Free Software Foundation, Inc.
   4
   5 ;; Author: David Kastrup
   6 ;; Keywords: tex, wp, convenience
   7
   8 ;; This file is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation; either version 3, or (at your option)
  11 ;; any later version.
  12
  13 ;; This file is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  20 ;; the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
  21 ;; Boston, MA 02110-1301, USA.
  22
  23 ;;; Commentary:
  24
  25 ;; This style is for the "seamless" embedding of generated images
  26 ;; into LaTeX source code.  Please see the README and INSTALL files
  27 ;; for further instruction.
  28 ;;
  29 ;; Please use the usual configure script for installation: more than
  30 ;; just Elisp files are involved: a LaTeX style, icon files, startup
  31 ;; code and so on.
  32 ;;
  33 ;; Quite a few things with regard to preview-latex's operation can be
  34 ;; configured by using
  35 ;; M-x customize-group RET preview RET
  36 ;;
  37 ;; Please report bugs with M-x preview-report-bug RET.
  38
  39 ;;; Code:
  40
  41 (require 'tex-site)
  42 (require 'tex)
  43 (require 'tex-buf)
  44 (require 'latex)
  45
  46 (eval-when-compile
  47   (condition-case nil
  48       (require 'desktop)
  49     (file-error (message "Missing desktop package:
  50 preview-latex buffers will not survive across sessions.")))
  51   (condition-case nil
  52       (require 'reporter)
  53     (file-error (message "Missing reporter library, probably from the mail-lib package:
  54 preview-latex's bug reporting commands will probably not work.")))
  55   (require 'info)
  56   (defvar error))
  57
  58 ;; we need the compatibility macros which do _not_ get byte-compiled.
  59 (eval-when-compile
  60   (if (featurep 'xemacs)
  61       (load-library "prv-xemacs.el")))
  62
  63 ;; if the above load-library kicked in, this will not cause anything
  64 ;; to get loaded.
  65 (require (if (featurep 'xemacs)
  66              'prv-xemacs 'prv-emacs))
  67
  68 (defgroup preview nil "Embed Preview images into LaTeX buffers."
  69   :group 'AUCTeX
  70   :prefix "preview-"
  71   :link '(custom-manual "(preview-latex)Top")
  72   :link '(info-link "(preview-latex)The Emacs interface")
  73   :link '(url-link :tag "Homepage" "http://www.gnu.org/software/auctex/"))
  74
  75 (defgroup preview-gs nil "Preview's Ghostscript renderer."
  76   :group 'preview
  77   :prefix "preview-")
  78
  79 (defgroup preview-appearance nil "Preview image appearance."
  80   :group 'preview
  81   :prefix "preview-")
  82
  83 (defconst preview-specs-type
  84   '(repeat
  85     (list :tag "Image spec"
  86           ;; Use an extra :value keyword to avoid a bug in
  87           ;; `widget-convert' of XEmacs 21.4 and Emacs 21.
  88           ;; Analogously for the following `const' statements.
  89           (const :format "" :value :type)
  90           (choice :tag "Image type"
  91                   (const xpm)
  92                   (const xbm)
  93                   (symbol :tag "Other"))
  94           (set :inline t :tag "Minimum font size"
  95                (list :inline t :tag ""
  96                      (const :format "" :value :min)
  97                      (integer :tag "pixels")))
  98           (const :format "" :value :file) (string :tag "Filename")
  99           (set :inline t :tag "Ascent ratio"
 100                (list :inline t :tag ""
 101                      (const :format "" :value :ascent)
 102                      (integer :tag "percent of image"
 103                               :value 50))))))
 104
 105 (defun preview-specs-setter (symbol value)
 106   "Set SYMBOL to VALUE and clear `preview-min-alist' property.
 107 This is used in icon specs, so that customizing will
 108 clear cached icons."
 109   (put symbol 'preview-min-alist nil)
 110   (set-default symbol value))
 111
 112 (defcustom preview-nonready-icon-specs
 113   '((:type xpm :min 26 :file "prvwrk24.xpm" :ascent 90)
 114     (:type xpm :min 22 :file "prvwrk20.xpm" :ascent 90)
 115     (:type xpm :min 17 :file "prvwrk16.xpm" :ascent 90)
 116     (:type xpm :min 15 :file "prvwrk14.xpm" :ascent 90)
 117     (:type xpm         :file "prvwrk12.xpm" :ascent 90)
 118     (:type xbm         :file "prvwrk24.xbm" :ascent 90))
 119   "The icon used for previews to be generated.
 120 The spec must begin with `:type'.  File names are relative to
 121 `load-path' and `data-directory', a spec `:min' requires a
 122 minimal pixel height for `preview-reference-face' before the spec
 123 will be considered.  Since evaluating the `:file' spec takes
 124 considerable time under XEmacs, it should come after the `:min'
 125 spec to avoid unnecessary evaluation time."
 126   :group 'preview-appearance
 127   :type preview-specs-type
 128   :set #'preview-specs-setter)
 129
 130 (defvar preview-nonready-icon)
 131
 132 (defcustom preview-error-icon-specs
 133   '((:type xpm :min 22 :file "prverr24.xpm" :ascent 90)
 134     (:type xpm :min 18 :file "prverr20.xpm" :ascent 90)
 135     (:type xpm         :file "prverr16.xpm" :ascent 90)
 136     (:type xbm         :file "prverr24.xbm" :ascent 90))
 137   "The icon used for PostScript errors.
 138 The spec must begin with `:type'.  File names are relative to
 139 `load-path' and `data-directory', a spec `:min' requires a
 140 minimal pixel height for `preview-reference-face' before the spec
 141 will be considered.  Since evaluating the `:file' spec takes
 142 considerable time under XEmacs, it should come after the `:min'
 143 spec to avoid unnecessary evaluation time."
 144   :group 'preview-appearance
 145   :type preview-specs-type
 146   :set #'preview-specs-setter
 147 )
 148
 149 (defvar preview-error-icon)
 150
 151 (defcustom preview-icon-specs
 152   '((:type xpm :min 24 :file "prvtex24.xpm" :ascent 75)
 153     (:type xpm :min 20 :file "prvtex20.xpm" :ascent 75)
 154     (:type xpm :min 16 :file "prvtex16.xpm" :ascent 75)
 155     (:type xpm         :file "prvtex12.xpm" :ascent 75)
 156     (:type xbm :min 24 :file "prvtex24.xbm" :ascent 75)
 157     (:type xbm :min 16 :file "prvtex16.xbm" :ascent 75)
 158     (:type xbm         :file "prvtex12.xbm" :ascent 75))
 159   "The icon used for an open preview.
 160 The spec must begin with `:type'.  File names are relative to
 161 `load-path' and `data-directory', a spec `:min' requires a
 162 minimal pixel height for `preview-reference-face' before the spec
 163 will be considered.  Since evaluating the `:file' spec takes
 164 considerable time under XEmacs, it should come after the `:min'
 165 spec to avoid unnecessary evaluation time."
 166   :group 'preview-appearance
 167   :type preview-specs-type
 168   :set #'preview-specs-setter)
 169
 170 (defvar preview-icon)
 171
 172 (defgroup preview-latex nil "LaTeX options for preview."
 173   :group 'preview
 174   :prefix "preview-")
 175
 176 (defcustom preview-image-creators
 177   '((dvipng
 178      (open preview-gs-open preview-dvipng-process-setup)
 179      (place preview-gs-place)
 180      (close preview-dvipng-close))
 181     (png (open preview-gs-open)
 182          (place preview-gs-place)
 183          (close preview-gs-close))
 184     (jpeg (open preview-gs-open)
 185           (place preview-gs-place)
 186           (close preview-gs-close))
 187     (pnm (open preview-gs-open)
 188           (place preview-gs-place)
 189           (close preview-gs-close))
 190     (tiff (open preview-gs-open)
 191           (place preview-gs-place)
 192           (close preview-gs-close)))
 193   "Define functions for generating images.
 194 These functions get called in the process of generating inline
 195 images of the specified type.  The open function is called
 196 at the start of a rendering pass, the place function for
 197 placing every image, the close function at the end of
 198 the pass.  Look at the documentation of the various
 199 functions used here for the default settings, and at
 200 the function `preview-call-hook' through which those are
 201 called.  Additional argument lists specified in here
 202 are passed to the functions before any additional
 203 arguments given to `preview-call-hook'.
 204
 205 Not all of these image types may be supported by your copy
 206 of Ghostscript, or by your copy of Emacs."
 207   :group 'preview-gs
 208   :type '(alist :key-type (symbol :tag "Preview's image type")
 209                 :value-type
 210                 (alist :tag "Handler" :key-type (symbol :tag "Operation:")
 211                        :value-type (list :tag "Handler"
 212                                          (function :tag "Handler function")
 213                                          (repeat :tag "Additional \
 214 function args" :inline t sexp))
 215                        :options (open place close))))
 216
 217 (defcustom preview-gs-image-type-alist
 218   '((png png "-sDEVICE=png16m")
 219     (dvipng png "-sDEVICE=png16m")
 220     (jpeg jpeg "-sDEVICE=jpeg")
 221     (pnm pbm "-sDEVICE=pnmraw")
 222     (tiff tiff "-sDEVICE=tiff12nc"))
 223   "*Alist of image types and corresponding Ghostscript options.
 224 The `dvipng' and `postscript' (don't use) entries really specify
 225 a fallback device when images can't be processed by the requested
 226 method, like when PDFTeX was used."
 227   :group 'preview-gs
 228   :type '(repeat (list :tag nil (symbol :tag "preview image-type")
 229                        (symbol :tag "Emacs image-type")
 230                        (repeat :inline t :tag "Ghostscript options" string))))
 231
 232 (defcustom preview-image-type 'png
 233   "*Image type to be used in images."
 234   :group 'preview-gs
 235   :type (append '(choice)
 236                 (mapcar (lambda (symbol) (list 'const (car symbol)))
 237                         preview-image-creators)
 238                 '((symbol :tag "Other"))))
 239
 240 (defun preview-call-hook (symbol &rest rest)
 241   "Call a function from `preview-image-creators'.
 242 This looks up SYMBOL in the `preview-image-creators' entry
 243 for the image type `preview-image-type' and calls the
 244 hook function given there with the arguments specified there
 245 followed by REST.  If such a function is specified in there,
 246 that is."
 247   (let ((hook (cdr (assq symbol
 248                     (cdr (assq preview-image-type
 249                                preview-image-creators))))))
 250     (when hook
 251       (apply (car hook) (append (cdr hook) rest)))))
 252
 253
 254 (defvar TeX-active-tempdir nil
 255   "List of directory name, top directory name and reference count.")
 256 (make-variable-buffer-local 'TeX-active-tempdir)
 257
 258 (defcustom preview-bb-filesize 1024
 259   "Size of file area scanned for bounding box information."
 260   :group 'preview-gs :type 'integer)
 261
 262 (defcustom preview-preserve-indentation t
 263   "*Whether to keep additional whitespace at the left of a line."
 264   :group 'preview-appearance :type 'boolean)
 265
 266 (defun preview-extract-bb (filename)
 267   "Extract EPS bounding box vector from FILENAME."
 268   (with-temp-buffer
 269     (insert-file-contents-literally filename nil 0 preview-bb-filesize
 270                                     t)
 271     (goto-char (point-min))
 272     (when (search-forward-regexp "%%BoundingBox:\
 273  +\\([-+]?[0-9.]+\\)\
 274  +\\([-+]?[0-9.]+\\)\
 275  +\\([-+]?[0-9.]+\\)\
 276  +\\([-+]?[0-9.]+\\)" nil t)
 277       (vector
 278        (if preview-preserve-indentation
 279            (min 72 (string-to-number (match-string 1)))
 280          (string-to-number (match-string 1)))
 281        (string-to-number (match-string 2))
 282        (string-to-number (match-string 3))
 283        (string-to-number (match-string 4))
 284        ))))
 285
 286 (defcustom preview-prefer-TeX-bb nil
 287   "*Prefer TeX bounding box to EPS one if available.
 288 If `preview-fast-conversion' is set, this option is not
 289  consulted since the TeX bounding box has to be used anyway."
 290   :group 'preview-gs
 291   :type 'boolean)
 292
 293 (defcustom preview-TeX-bb-border 0.5
 294   "*Additional space in pt around Bounding Box from TeX."
 295   :group 'preview-gs
 296   :type 'number)
 297
 298 (defvar preview-coding-system nil
 299   "Coding system used for LaTeX process.")
 300 (make-variable-buffer-local 'preview-coding-system)
 301 (defvar preview-parsed-font-size nil
 302   "Font size as parsed from the log of LaTeX run.")
 303 (make-variable-buffer-local 'preview-parsed-font-size)
 304 (defvar preview-parsed-magnification nil
 305   "Magnification as parsed from the log of LaTeX run.")
 306 (make-variable-buffer-local 'preview-parsed-magnification)
 307 (defvar preview-parsed-pdfoutput nil
 308   "PDFoutput as parsed from the log of LaTeX run.")
 309 (make-variable-buffer-local 'preview-parsed-pdfoutput)
 310 (defvar preview-parsed-counters nil
 311   "Counters as parsed from the log of LaTeX run.")
 312 (make-variable-buffer-local 'preview-parsed-counters)
 313 (defvar preview-parsed-tightpage nil
 314   "Tightpage as parsed from the log of LaTeX run.")
 315 (make-variable-buffer-local 'preview-parsed-tightpage)
 316
 317 (defun preview-get-magnification ()
 318   "Get magnification from `preview-parsed-magnification'."
 319   (if preview-parsed-magnification
 320       (/ preview-parsed-magnification 1000.0) 1.0))
 321
 322 (defun preview-TeX-bb (list)
 323   "Calculate bounding box from (ht dp wd).
 324 LIST consists of TeX dimensions in sp (1/65536 TeX point)."
 325   (and
 326    (consp list)
 327    (let* ((dims (vconcat (mapcar
 328                           #'(lambda (x)
 329                               (/ x 65781.76)) list)))
 330           (box
 331            (vector
 332             (+ 72 (min 0 (aref dims 2)))
 333             (+ 720 (min (aref dims 0) (- (aref dims 1)) 0))
 334             (+ 72 (max 0 (aref dims 2)))
 335             (+ 720 (max (aref dims 0) (- (aref dims 1)) 0))))
 336           (border (if preview-parsed-tightpage
 337                       (vconcat (mapcar
 338                                 #'(lambda(x)
 339                                     (/ x 65781.76)) preview-parsed-tightpage))
 340                     (vector (- preview-TeX-bb-border)
 341                             (- preview-TeX-bb-border)
 342                             preview-TeX-bb-border
 343                             preview-TeX-bb-border))))
 344      (dotimes (i 4 box)
 345        (aset box i (+ (aref box i) (aref border i)))))))
 346
 347 (defcustom preview-gs-command
 348   (or ;; The GS wrapper coming with TeX Live
 349       (executable-find "rungs")
 350       ;; The MikTeX builtin GS
 351       (let ((gs (executable-find "mgs")))
 352         ;; Check if mgs is functional for external non-MikTeX apps.
 353         ;; See http://blog.miktex.org/post/2005/04/07/Starting-mgsexe-at-the-DOS-Prompt.aspx
 354         (when (and gs (= 0 (shell-command (concat gs " -q -dNODISPLAY -c quit"))))
 355           gs))
 356       ;; Windows ghostscript
 357       (executable-find "GSWIN32C.EXE")
 358       ;; standard GhostScript
 359       (executable-find "gs"))
 360   "*How to call gs for conversion from EPS.  See also `preview-gs-options'."
 361   :group 'preview-gs
 362   :type 'string)
 363
 364 (defcustom preview-gs-options '("-q" "-dDELAYSAFER" "-dNOPAUSE"
 365                                 "-DNOPLATFONTS" "-dPrinted"
 366                                 "-dTextAlphaBits=4"
 367                                 "-dGraphicsAlphaBits=4")
 368   "*Options with which to call gs for conversion from EPS.
 369 See also `preview-gs-command'."
 370   :group 'preview-gs
 371   :type '(repeat string))
 372
 373 (defvar preview-gs-queue nil
 374   "List of overlays to convert using gs.
 375 Buffer-local to the appropriate TeX process buffer.")
 376 (make-variable-buffer-local 'preview-gs-queue)
 377
 378 (defvar preview-gs-outstanding nil
 379   "Overlays currently processed.")
 380 (make-variable-buffer-local 'preview-gs-outstanding)
 381
 382 (defcustom preview-gs-outstanding-limit 2
 383   "*Number of requests allowed to be outstanding.
 384 This is the number of not-yet-completed requests we
 385 might at any time have piped into Ghostscript.  If
 386 this number is larger, the probability of Ghostscript
 387 working continuously is higher when Emacs is rather
 388 busy.  If this number is smaller, redisplay will
 389 follow changes in the displayed buffer area faster."
 390   :group 'preview-gs
 391   :type '(restricted-sexp
 392           :match-alternatives
 393           ((lambda (value) (and
 394                             (integerp value)
 395                             (> value 0)
 396                             (< value 10))))
 397           :tag "small number"))
 398
 399 (defvar preview-gs-answer nil
 400   "Accumulated answer of Ghostscript process.")
 401 (make-variable-buffer-local 'preview-gs-answer)
 402
 403 (defvar preview-gs-image-type nil
 404   "Image type for gs produced images.")
 405 (make-variable-buffer-local 'preview-gs-image-type)
 406
 407 (defvar preview-gs-sequence nil
 408   "Pair of sequence numbers for gs produced images.")
 409 (make-variable-buffer-local 'preview-gs-sequence)
 410
 411 (defvar preview-scale nil
 412   "Screen scale of images.
 413 Magnify by this factor to make images blend with other
 414 screen content.  Buffer-local to rendering buffer.")
 415 (make-variable-buffer-local 'preview-scale)
 416
 417 (defvar preview-colors nil
 418   "Color setup list.
 419 An array with elements 0, 1 and 2 for background,
 420 foreground and border colors, respectively.  Each element
 421 is a list of 3 real numbers between 0 and 1, or NIL
 422 of nothing special should be done for the color")
 423 (make-variable-buffer-local 'preview-colors)
 424
 425 (defvar preview-gs-init-string nil
 426   "Ghostscript setup string.")
 427 (make-variable-buffer-local 'preview-gs-init-string)
 428
 429 (defvar preview-ps-file nil
 430   "PostScript file name for fast conversion.")
 431 (make-variable-buffer-local 'preview-ps-file)
 432
 433 (defvar preview-gs-dsc nil
 434   "Parsed DSC information.")
 435 (make-variable-buffer-local 'preview-gs-dsc)
 436
 437 (defvar preview-resolution nil
 438   "Screen resolution where rendering started.
 439 Cons-cell of x and y resolution, given in
 440 dots per inch.  Buffer-local to rendering buffer.")
 441 (make-variable-buffer-local 'preview-resolution)
 442
 443 (defun preview-gs-resolution (scale xres yres)
 444   "Generate resolution argument for gs.
 445 Calculated from real-life factor SCALE and XRES and
 446 YRES, the screen resolution in dpi."
 447   (format "-r%gx%g"
 448           (/ (* scale xres) (preview-get-magnification))
 449           (/ (* scale yres) (preview-get-magnification))))
 450
 451 (defun preview-gs-behead-outstanding (err)
 452   "Remove leading element of outstanding queue after error.
 453 Return element if non-nil.  ERR is the error string to
 454 show as response of Ghostscript."
 455   (let ((ov (pop preview-gs-outstanding)))
 456     (when ov
 457       (preview-gs-flag-error ov err)
 458       (overlay-put ov 'queued nil))
 459     ov))
 460
 461 (defvar preview-gs-command-line nil)
 462 (make-variable-buffer-local 'preview-gs-command-line)
 463 (defvar preview-gs-file nil)
 464 (make-variable-buffer-local 'preview-gs-file)
 465
 466 (defcustom preview-fast-conversion t
 467   "*Set this for single-file PostScript conversion.
 468 This will have no effect when `preview-image-type' is
 469 set to `postscript'."
 470   :group 'preview-latex
 471   :type 'boolean)
 472
 473 (defun preview-string-expand (arg &optional separator)
 474   "Expand ARG as a string.
 475 It can already be a string.  Or it can be a list, then it is
 476 recursively evaluated using SEPARATOR as separator.  If a list
 477 element is in itself a CONS cell, the CAR of the list (after symbol
 478 dereferencing) can evaluate to either a string, in which case it is
 479 used as a separator for the rest of the list,
 480 or a boolean (t or nil) in which case the rest of the list is
 481 either evaluated and concatenated or ignored, respectively.
 482 ARG can be a symbol, and so can be the CDR
 483 of a cell used for string concatenation."
 484   (cond
 485    ((stringp arg) arg)
 486    ((consp arg)
 487     (mapconcat
 488      #'identity
 489      (delq nil
 490            (mapcar
 491             (lambda(x)
 492               (if (consp x)
 493                   (let ((sep (car x)))
 494                     (while (and (symbolp sep)
 495                                 (not (memq sep '(t nil))))
 496                       (setq sep (symbol-value sep)))
 497                     (if (stringp sep)
 498                         (preview-string-expand (cdr x) sep)
 499                       (and sep
 500                            (preview-string-expand (cdr x)))))
 501                 (preview-string-expand x)))
 502             arg))
 503      (or separator "")))
 504    ((and (symbolp arg) (not (memq arg '(t nil))))
 505     (preview-string-expand (symbol-value arg) separator))
 506    (t (error "Bad string expansion"))))
 507
 508 (defconst preview-expandable-string
 509   ((lambda (f) (funcall f (funcall f 'sexp)))
 510    (lambda (x)
 511      `(choice
 512        string
 513        (repeat :tag "Concatenate"
 514         (choice
 515          string
 516          (cons :tag "Separated list"
 517                (choice (string :tag "Separator")
 518                        (symbol :tag "Indirect separator or flag"))
 519                ,x)
 520          (symbol :tag "Indirect variable (no separator)")))
 521        (symbol :tag "Indirect variable (with separator)"))))
 522   "Type to be used for `preview-string-expand'.
 523 Just a hack until we get to learn how to do this properly.
 524 Recursive definitions are not popular with Emacs,
 525 so we define this type just two levels deep.  This
 526 kind of expandible string can either be just a string, or a
 527 cons cell with a separator string in the CAR, and either
 528 an explicit list of elements in the CDR, or a symbol to
 529 be consulted recursively.")
 530
 531 (defcustom preview-dvipng-command
 532   "dvipng -picky -noghostscript %d -o \"%m/prev%%03d.png\""
 533   "*Command used for converting to separate PNG images.
 534
 535 You might specify options for converting to other image types,
 536 but then you'll need to adapt `preview-dvipng-image-type'."
 537   :group 'preview-latex
 538   :type 'string)
 539
 540 (defcustom preview-dvipng-image-type
 541   'png
 542   "*Image type that dvipng produces.
 543
 544 You'll need to change `preview-dvipng-command' too,
 545 if you customize this."
 546   :group 'preview-latex
 547   :type '(choice (const png)
 548                  (const gif)
 549                  (symbol :tag "Other" :value png)))
 550
 551 (defcustom preview-dvips-command
 552   "dvips -Pwww -i -E %d -o %m/preview.000"
 553   "*Command used for converting to separate EPS images."
 554   :group 'preview-latex
 555   :type 'string)
 556
 557 (defcustom preview-fast-dvips-command
 558   "dvips -Pwww %d -o %m/preview.ps"
 559   "*Command used for converting to a single PS file."
 560   :group 'preview-latex
 561   :type 'string)
 562
 563 (defcustom preview-pdf2dsc-command
 564   "pdf2dsc %s.pdf %m/preview.dsc"
 565   "*Command used for generating dsc from a PDF file."
 566   :group 'preview-latex
 567   :type 'string)
 568
 569 (defun preview-gs-queue-empty ()
 570   "Kill off everything remaining in `preview-gs-queue'."
 571   (mapc #'preview-delete preview-gs-outstanding)
 572   (dolist (ov preview-gs-queue)
 573     (if (overlay-get ov 'queued)
 574         (preview-delete ov)))
 575   (setq preview-gs-outstanding nil)
 576   (setq preview-gs-queue nil))
 577
 578 (defvar preview-error-condition nil
 579   "Last error raised and to be reported.")
 580
 581 (defun preview-log-error (err context &optional process)
 582   "Log an error message to run buffer.
 583 ERR is the caught error syndrome, CONTEXT is where it
 584 occured, PROCESS is the process for which the run-buffer
 585 is to be used."
 586   (when (or (null process) (buffer-name (process-buffer process)))
 587     (with-current-buffer (or (and process
 588                                   (process-buffer process))
 589                              (current-buffer))
 590       (save-excursion
 591         (goto-char (or (and process
 592                             (process-buffer process)
 593                             (marker-buffer (process-mark process))
 594                             (process-mark process))
 595                        (point-max)))
 596         (insert-before-markers
 597          (format "%s: %s\n"
 598                  context (error-message-string err)))
 599         (display-buffer (current-buffer)))))
 600   (setq preview-error-condition err))
 601
 602 (defun preview-reraise-error (&optional process)
 603   "Raise an error that has been logged.
 604 Makes sure that PROCESS is removed from the \"Compilation\"
 605 tag in the mode line."
 606   (when preview-error-condition
 607     (unwind-protect
 608         (signal (car preview-error-condition) (cdr preview-error-condition))
 609       (setq preview-error-condition nil
 610             compilation-in-progress (delq process compilation-in-progress)))))
 611
 612 (defun preview-gs-sentinel (process string)
 613   "Sentinel function for rendering process.
 614 Gets the default PROCESS and STRING arguments
 615 and tries to restart Ghostscript if necessary."
 616   (condition-case err
 617       (let ((status (process-status process)))
 618         (when (memq status '(exit signal))
 619           (setq compilation-in-progress (delq process compilation-in-progress)))
 620         (when (buffer-name (process-buffer process))
 621           (with-current-buffer (process-buffer process)
 622             (goto-char (point-max))
 623             (insert-before-markers "\n" mode-name " " string)
 624             (forward-char -1)
 625             (insert " at "
 626                     (substring (current-time-string) 0 -5))
 627             (forward-char 1)
 628             (TeX-command-mode-line process)
 629             (when (memq status '(exit signal))
 630               ;; process died.
 631               ;;  Throw away culprit, go on.
 632               (let* ((err (concat preview-gs-answer "\n"
 633                                   (process-name process) " " string))
 634                      (ov (preview-gs-behead-outstanding err)))
 635                 (when (and (null ov) preview-gs-queue)
 636                   (save-excursion
 637                     (goto-char (if (marker-buffer (process-mark process))
 638                                    (process-mark process)
 639                                  (point-max)))
 640                     (insert-before-markers err)))
 641                 (delete-process process)
 642                 (if (or (null ov)
 643                         (eq status 'signal))
 644                     ;; if process was killed explicitly by signal, or if nothing
 645                     ;; was processed, we give up on the matter altogether.
 646                     (progn
 647                       (when preview-ps-file
 648                         (condition-case nil
 649                             (preview-delete-file preview-ps-file)
 650                           (file-error nil)))
 651                       (preview-gs-queue-empty))
 652
 653                   ;; restart only if we made progress since last call
 654                   (let (filenames)
 655                     (dolist (ov preview-gs-outstanding)
 656                       (setq filenames (overlay-get ov 'filenames))
 657                       (condition-case nil
 658                           (preview-delete-file (nth 1 filenames))
 659                         (file-error nil))
 660                       (setcdr filenames nil)))
 661                   (setq preview-gs-queue (nconc preview-gs-outstanding
 662                                                 preview-gs-queue))
 663                   (setq preview-gs-outstanding nil)
 664                   (preview-gs-restart)))))))
 665     (error (preview-log-error err "Ghostscript" process)))
 666   (preview-reraise-error process))
 667
 668 (defun preview-gs-filter (process string)
 669   "Filter function for processing Ghostscript output.
 670 Gets the usual PROCESS and STRING parameters, see
 671 `set-process-filter' for a description."
 672   (with-current-buffer (process-buffer process)
 673     (setq preview-gs-answer (concat preview-gs-answer string))
 674     (while (string-match "GS\\(<[0-9]+\\)?>" preview-gs-answer)
 675       (let* ((pos (match-end 0))
 676              (answer (substring preview-gs-answer 0 pos)))
 677         (setq preview-gs-answer (substring preview-gs-answer pos))
 678         (condition-case err
 679             (preview-gs-transact process answer)
 680           (error (preview-log-error err "Ghostscript filter" process))))))
 681   (preview-reraise-error))
 682
 683 (defun preview-gs-restart ()
 684   "Start a new Ghostscript conversion process."
 685   (when preview-gs-queue
 686     (if preview-gs-sequence
 687         (setcar preview-gs-sequence (1+ (car preview-gs-sequence)))
 688       (setq preview-gs-sequence (list 1)))
 689     (setcdr preview-gs-sequence 1)
 690     (let* ((process-connection-type nil)
 691            (outfile (format "-dOutputFile=%s"
 692                             (preview-ps-quote-filename
 693                              (format "%s/pr%d-%%d.%s"
 694                                      (car TeX-active-tempdir)
 695                                      (car preview-gs-sequence)
 696                                      preview-gs-image-type))))
 697            (process
 698             (apply #'start-process
 699                    "Preview-Ghostscript"
 700                    (current-buffer)
 701                    preview-gs-command
 702                    outfile
 703                    preview-gs-command-line)))
 704       (goto-char (point-max))
 705       (insert-before-markers "Running `Preview-Ghostscript' with ``"
 706                              (mapconcat #'shell-quote-argument
 707                                         (append
 708                                          (list preview-gs-command
 709                                                outfile)
 710                                          preview-gs-command-line)
 711                                         " ") "''\n")
 712       (setq preview-gs-answer "")
 713       (process-kill-without-query process)
 714       (set-process-sentinel process #'preview-gs-sentinel)
 715       (set-process-filter process #'preview-gs-filter)
 716       (process-send-string process preview-gs-init-string)
 717       (setq mode-name "Preview-Ghostscript")
 718       (push process compilation-in-progress)
 719       (TeX-command-mode-line process)
 720       (set-buffer-modified-p (buffer-modified-p))
 721       process)))
 722
 723 (defun preview-gs-open (&optional setup)
 724   "Start a Ghostscript conversion pass.
 725 SETUP may contain a parser setup function."
 726   (let ((image-info (assq preview-image-type preview-gs-image-type-alist)))
 727     (setq preview-gs-image-type (nth 1 image-info))
 728     (setq preview-gs-sequence nil)
 729     (setq preview-gs-command-line (append
 730                                    preview-gs-options
 731                                    (nthcdr 2 image-info))
 732           preview-gs-init-string
 733           (format "{DELAYSAFER{.setsafe}if}stopped pop\
 734 /.preview-BP currentpagedevice/BeginPage get dup \
 735 null eq{pop{pop}bind}if def\
 736 <</BeginPage{currentpagedevice/PageSize get dup 0 get 1 ne exch 1 get 1 ne or\
 737 {.preview-BP %s}{pop}ifelse}bind/PageSize[1 1]>>setpagedevice\
 738 /preview-do{[count 3 roll save]3 1 roll dup length 0 eq\
 739 {pop}{setpagedevice}{ifelse .runandhide}\
 740 stopped{handleerror quit}if \
 741 aload pop restore}bind def "
 742                   (preview-gs-color-string preview-colors)))
 743     (preview-gs-queue-empty)
 744     (preview-parse-messages (or setup #'preview-gs-dvips-process-setup))))
 745
 746 (defun preview-gs-color-value (value)
 747   "Return string to be used as color value for an RGB component.
 748 Conversion from Emacs color numbers (0 to 65535) in VALUE
 749 to Ghostscript floats."
 750   (format "%g" (/ value 65535.0)))
 751
 752 (defun preview-pdf-color-string (colors)
 753   "Return a string that patches PDF foreground color to work properly."
 754   ;; Actually, this is rather brutal.  It will only be invoked in
 755   ;; cases, however, where previously it was not expected that
 756   ;; anything readable turned up, anyway.
 757   (let ((fg (aref colors 1)))
 758     (if fg
 759         (concat
 760          "/GS_PDF_ProcSet GS_PDF_ProcSet dup maxlength dict copy dup begin\
 761 /graphicsbeginpage{//graphicsbeginpage exec "
 762          (mapconcat #'preview-gs-color-value fg " ")
 763          " 3 copy rg RG}bind store end readonly store "))))
 764
 765 (defun preview-gs-color-string (colors)
 766   "Return a string setting up colors"
 767   (let ((bg (aref colors 0))
 768         (fg (aref colors 1))
 769         (mask (aref colors 2))
 770         (border (aref colors 3)))
 771     (concat
 772      (and (or (and mask border) (and bg (not fg)))
 773           "gsave ")
 774      (and bg
 775          (concat
 776           (mapconcat #'preview-gs-color-value bg " ")
 777           " setrgbcolor clippath fill "))
 778      (and mask border
 779          (format "%s setrgbcolor false setstrokeadjust %g \
 780 setlinewidth clippath strokepath \
 781 matrix setmatrix true \
 782 {2 index{newpath}if round exch round exch moveto pop false}\
 783 {round exch round exch lineto}{curveto}{closepath}\
 784 pathforall pop fill "
 785                  (mapconcat #'preview-gs-color-value mask " ")
 786                  (* 2 border)))
 787           ;; I hate antialiasing.  Warp border to integral coordinates.
 788      (and (or (and mask border) (and bg (not fg)))
 789           "grestore ")
 790      (and fg
 791           (concat
 792            (mapconcat #'preview-gs-color-value fg " ")
 793            " setrgbcolor")))))
 794
 795 (defun preview-dvipng-color-string (colors res)
 796   "Return color setup tokens for dvipng.
 797 Makes a string of options suitable for passing to dvipng.
 798 Pure borderless black-on-white will return an empty string."
 799   (let
 800       ((bg (aref colors 0))
 801        (fg (aref colors 1))
 802        (mask (aref colors 2))
 803        (border (aref colors 3)))
 804     (concat
 805      (and bg
 806           (format "--bg 'rgb %s' "
 807                   (mapconcat #'preview-gs-color-value bg " ")))
 808      (and fg
 809           (format "--fg 'rgb %s' "
 810                   (mapconcat #'preview-gs-color-value fg " ")))
 811      (and mask border
 812           (format "--bd 'rgb %s' "
 813                   (mapconcat #'preview-gs-color-value mask " ")))
 814      (and border
 815           (format "--bd %d" (max 1 (round (/ (* res border) 72.0))))))))
 816
 817 (defun preview-gs-dvips-process-setup ()
 818   "Set up Dvips process for conversions via gs."
 819   (unless (preview-supports-image-type preview-gs-image-type)
 820     (error "preview-image-type setting '%s unsupported by this Emacs"
 821            preview-gs-image-type))
 822   (setq preview-gs-command-line (append
 823                                  preview-gs-command-line
 824                                  (list (preview-gs-resolution
 825                                         (preview-hook-enquiry preview-scale)
 826                                         (car preview-resolution)
 827                                         (cdr preview-resolution)))))
 828   (if preview-parsed-pdfoutput
 829       (preview-pdf2dsc-process-setup)
 830     (let ((process (preview-start-dvips preview-fast-conversion)))
 831       (setq TeX-sentinel-function #'preview-gs-dvips-sentinel)
 832       (list process (current-buffer) TeX-active-tempdir preview-ps-file
 833             preview-gs-image-type))))
 834
 835 (defun preview-dvipng-process-setup ()
 836   "Set up dvipng process for conversion."
 837   (setq preview-gs-command-line (append
 838                                  preview-gs-command-line
 839                                  (list (preview-gs-resolution
 840                                         (preview-hook-enquiry preview-scale)
 841                                         (car preview-resolution)
 842                                         (cdr preview-resolution)))))
 843   (if preview-parsed-pdfoutput
 844       (if (preview-supports-image-type preview-gs-image-type)
 845           (preview-pdf2dsc-process-setup)
 846         (error "preview-image-type setting '%s unsupported by this Emacs"
 847                preview-gs-image-type))
 848     (unless (preview-supports-image-type preview-dvipng-image-type)
 849       (error "preview-dvipng-image-type setting '%s unsupported by this Emacs"
 850              preview-dvipng-image-type))
 851     (let ((process (preview-start-dvipng)))
 852       (setq TeX-sentinel-function #'preview-dvipng-sentinel)
 853       (list process (current-buffer) TeX-active-tempdir t
 854           preview-dvipng-image-type))))
 855
 856
 857 (defun preview-pdf2dsc-process-setup ()
 858   (let ((process (preview-start-pdf2dsc)))
 859     (setq TeX-sentinel-function #'preview-pdf2dsc-sentinel)
 860     (list process (current-buffer) TeX-active-tempdir preview-ps-file
 861           preview-gs-image-type)))
 862
 863 (defun preview-dvips-abort ()
 864   "Abort a Dvips run."
 865   (preview-gs-queue-empty)
 866   (condition-case nil
 867       (delete-file
 868        (let ((gsfile preview-gs-file))
 869          (with-current-buffer TeX-command-buffer
 870            (funcall (car gsfile) "dvi"))))
 871     (file-error nil))
 872   (when preview-ps-file
 873       (condition-case nil
 874           (preview-delete-file preview-ps-file)
 875         (file-error nil)))
 876   (setq TeX-sentinel-function nil))
 877
 878 (defalias 'preview-dvipng-abort 'preview-dvips-abort)
 879 ;  "Abort a DviPNG run.")
 880
 881 (defun preview-gs-dvips-sentinel (process command &optional gsstart)
 882   "Sentinel function for indirect rendering DviPS process.
 883 The usual PROCESS and COMMAND arguments for
 884 `TeX-sentinel-function' apply.  Starts gs if GSSTART is set."
 885   (condition-case err
 886       (let ((status (process-status process))
 887             (gsfile preview-gs-file))
 888         (cond ((eq status 'exit)
 889                (delete-process process)
 890                (setq TeX-sentinel-function nil)
 891                (condition-case nil
 892                    (delete-file
 893                     (with-current-buffer TeX-command-buffer
 894                       (funcall (car gsfile) "dvi")))
 895                  (file-error nil))
 896                (if preview-ps-file
 897                    (preview-prepare-fast-conversion))
 898                (when gsstart
 899                  (if preview-gs-queue
 900                      (preview-gs-restart)
 901                    (when preview-ps-file
 902                      (condition-case nil
 903                          (preview-delete-file preview-ps-file)
 904                        (file-error nil))))))
 905               ((eq status 'signal)
 906                (delete-process process)
 907                (preview-dvips-abort))))
 908     (error (preview-log-error err "DviPS sentinel" process)))
 909   (preview-reraise-error process))
 910
 911 (defun preview-pdf2dsc-sentinel (process command &optional gsstart)
 912   "Sentinel function for indirect rendering PDF process.
 913 The usual PROCESS and COMMAND arguments for
 914 `TeX-sentinel-function' apply.  Starts gs if GSSTART is set."
 915   (condition-case err
 916       (let ((status (process-status process)))
 917         (cond ((eq status 'exit)
 918                (delete-process process)
 919                (setq TeX-sentinel-function nil)
 920                (setq preview-gs-init-string
 921                      (concat preview-gs-init-string
 922                              (preview-pdf-color-string preview-colors)))
 923                (preview-prepare-fast-conversion)
 924                (when gsstart
 925                  (if preview-gs-queue
 926                      (preview-gs-restart)
 927                    (when preview-ps-file
 928                      (condition-case nil
 929                          (preview-delete-file preview-ps-file)
 930                        (file-error nil))))))
 931               ((eq status 'signal)
 932                (delete-process process)
 933                (preview-dvips-abort))))
 934     (error (preview-log-error err "PDF2DSC sentinel" process)))
 935   (preview-reraise-error process))
 936
 937 (defun preview-gs-close (process closedata)
 938   "Clean up after PROCESS and set up queue accumulated in CLOSEDATA."
 939   (setq preview-gs-queue (nconc preview-gs-queue closedata))
 940   (if process
 941       (if preview-gs-queue
 942           (if TeX-process-asynchronous
 943               (if (and (eq (process-status process) 'exit)
 944                        (null TeX-sentinel-function))
 945                   ;; Process has already finished and run sentinel
 946                   (progn
 947                     (when preview-ps-file
 948                       (condition-case nil
 949                           (preview-delete-file preview-ps-file)
 950                         (file-error nil)))
 951                     (preview-gs-restart))
 952                 (setq TeX-sentinel-function
 953                       `(lambda (process command)
 954                          (,(if preview-parsed-pdfoutput
 955                                'preview-pdf2dsc-sentinel
 956                              'preview-gs-dvips-sentinel)
 957                           process
 958                           command
 959                           t))))
 960             (TeX-synchronous-sentinel "Preview-DviPS" (cdr preview-gs-file)
 961                                       process))
 962     ;; pathological case: no previews although we sure thought so.
 963         (delete-process process)
 964         (unless (eq (process-status process) 'signal)
 965           (preview-dvips-abort)))))
 966
 967 (defun preview-dvipng-sentinel (process command &optional placeall)
 968   "Sentinel function for indirect rendering DviPNG process.
 969 The usual PROCESS and COMMAND arguments for
 970 `TeX-sentinel-function' apply.  Places all snippets if PLACEALL is set."
 971   (condition-case err
 972       (let ((status (process-status process)))
 973         (cond ((eq status 'exit)
 974                (delete-process process)
 975                (setq TeX-sentinel-function nil)
 976                (when placeall
 977                  (preview-dvipng-place-all)))
 978               ((eq status 'signal)
 979                (delete-process process)
 980                (preview-dvipng-abort))))
 981     (error (preview-log-error err "DviPNG sentinel" process)))
 982   (preview-reraise-error process))
 983
 984 (defun preview-dvipng-close (process closedata)
 985   "Clean up after PROCESS and set up queue accumulated in CLOSEDATA."
 986   (if preview-parsed-pdfoutput
 987       (preview-gs-close process closedata)
 988     (setq preview-gs-queue (nconc preview-gs-queue closedata))
 989     (if process
 990         (if preview-gs-queue
 991             (if TeX-process-asynchronous
 992                 (if (and (eq (process-status process) 'exit)
 993                          (null TeX-sentinel-function))
 994                     ;; Process has already finished and run sentinel
 995                     (preview-dvipng-place-all)
 996                   (setq TeX-sentinel-function (lambda (process command)
 997                                                 (preview-dvipng-sentinel
 998                                                  process
 999                                                  command
1000                                                  t))))
1001               (TeX-synchronous-sentinel "Preview-DviPNG" (cdr preview-gs-file)
1002                                         process))
1003           ;; pathological case: no previews although we sure thought so.
1004           (delete-process process)
1005           (unless (eq (process-status process) 'signal)
1006             (preview-dvipng-abort))))))
1007
1008 (defun preview-dsc-parse (file)
1009   "Parse DSC comments of FILE.
1010 Returns a vector with offset/length pairs corresponding to
1011 the pages.  Page 0 corresponds to the initialization section."
1012   (with-temp-buffer
1013     (set-buffer-multibyte nil)
1014     (insert-file-contents-literally file)
1015     (let ((last-pt (point-min))
1016           trailer
1017           pagelist
1018           lastbegin
1019           pt
1020           case-fold-search
1021           (level 0))
1022       (while (search-forward-regexp "\
1023 %%\\(?:\\(BeginDocument:\\)\\|\
1024 \\(EndDocument[\n\r]\\)\\|\
1025 \\(Page:\\)\\|\
1026 \\(Trailer[\n\r]\\)\\)" nil t)
1027         (setq pt (match-beginning 0))
1028         (cond ((null (memq (char-before pt) '(?\C-j ?\C-m nil))))
1029               (trailer (error "Premature %%%%Trailer in `%s' at offsets %d/%d"
1030                               file trailer pt))
1031               ((match-beginning 1)
1032                (if (zerop level)
1033                    (setq lastbegin pt))
1034                (setq level (1+ level)))
1035               ((match-beginning 2)
1036                (if (zerop level)
1037                    (error "Unmatched %%%%EndDocument in `%s' at offset %d"
1038                           file pt)
1039                  (setq level (1- level))))
1040               ((> level 0))
1041               ((match-beginning 3)
1042                (push (list last-pt (- pt last-pt)) pagelist)
1043                (setq last-pt pt))
1044               ((match-beginning 4)
1045                (setq trailer pt))))
1046       (unless (zerop level)
1047         (error "Unmatched %%%%BeginDocument in `%s' at offset %d"
1048                file lastbegin))
1049       (push (list last-pt
1050                   (- (or trailer (point-max)) last-pt)) pagelist)
1051       (vconcat (nreverse pagelist)))))
1052
1053 (defun preview-gs-dsc-cvx (page dsc)
1054   "Generate PostScript code accessing PAGE in the DSC object.
1055 The returned PostScript code will need the file on
1056 top of the stack, and will replace it with an executable
1057 object corresponding to the wanted page."
1058   (let ((curpage (aref dsc page)))
1059     (format "dup %d setfileposition %d()/SubFileDecode filter cvx"
1060             (1- (car curpage)) (nth 1 curpage))))
1061
1062 (defun preview-ps-quote-filename (str &optional nonrel)
1063   "Make a PostScript string from filename STR.
1064 The file name is first made relative unless
1065 NONREL is not NIL."
1066   (unless nonrel (setq str (file-relative-name str)))
1067   (let ((index 0))
1068     (while (setq index (string-match "[\\()]" str index))
1069       (setq str (replace-match "\\\\\\&" t nil str)
1070             index (+ 2 index)))
1071     (concat "(" str ")")))
1072
1073 (defun preview-prepare-fast-conversion ()
1074   "This fixes up all parameters for fast conversion."
1075   (let* ((file (if (consp (car preview-ps-file))
1076                    (if (consp (caar preview-ps-file))
1077                        (car (last (caar preview-ps-file)))
1078                      (caar preview-ps-file))
1079                  (car preview-ps-file)))
1080          (all-files (if (and (consp (car preview-ps-file))
1081                              (consp (caar preview-ps-file)))
1082                         (caar preview-ps-file)
1083                       (list file))))
1084     (setq preview-gs-dsc (preview-dsc-parse file))
1085     (setq preview-gs-init-string
1086           (concat (format "{<</PermitFileReading[%s]>> setuserparams \
1087 .locksafe} stopped pop "
1088                           (mapconcat 'preview-ps-quote-filename all-files ""))
1089                   preview-gs-init-string
1090                   (format "[%s(r)file]aload exch %s .runandhide aload pop "
1091                           (preview-ps-quote-filename file)
1092                           (preview-gs-dsc-cvx 0 preview-gs-dsc))))))
1093
1094 (defun preview-gs-urgentize (ov buff)
1095   "Make a displayed overlay render with higher priority.
1096 This function is used in fake conditional display properties
1097 for reordering the conversion order to prioritize on-screen
1098 images.  OV is the overlay in question, and BUFF is the
1099 Ghostscript process buffer where the buffer-local queue
1100 is located."
1101   ;; It does not matter that ov gets queued twice in that process: the
1102   ;; first version to get rendered will clear the 'queued property.
1103   ;; It cannot get queued more than twice since we remove the
1104   ;; conditional display property responsible for requeuing here.
1105   ;; We don't requeue if the overlay has been killed (its buffer made
1106   ;; nil).  Not necessary, but while we are checking...
1107   ;; We must return t.
1108   (preview-remove-urgentization ov)
1109   (when (and (overlay-get ov 'queued)
1110              (overlay-buffer ov))
1111     (with-current-buffer buff
1112       (push ov preview-gs-queue)))
1113   t)
1114
1115
1116 (defun preview-gs-place (ov snippet box run-buffer tempdir ps-file imagetype)
1117   "Generate an image placeholder rendered over by Ghostscript.
1118 This enters OV into all proper queues in order to make it render
1119 this image for real later, and returns the overlay after setting
1120 a placeholder image.  SNIPPET gives the number of the
1121 snippet in question for the file to be generated.
1122 BOX is a bounding box if we already know one via TeX.
1123 RUN-BUFFER is the buffer of the TeX process,
1124 TEMPDIR is the correct copy of `TeX-active-tempdir',
1125 PS-FILE is a copy of `preview-ps-file', IMAGETYPE is the image type
1126 for the file extension."
1127   (overlay-put ov 'filenames
1128                (unless (eq ps-file t)
1129                  (list
1130                   (preview-make-filename
1131                    (or ps-file
1132                        (format "preview.%03d" snippet))
1133                    tempdir))))
1134   (overlay-put ov 'queued
1135                (vector box nil snippet))
1136   (overlay-put ov 'preview-image
1137                (list (preview-icon-copy preview-nonready-icon)))
1138   (preview-add-urgentization #'preview-gs-urgentize ov run-buffer)
1139   (list ov))
1140
1141 (defun preview-mouse-open-error (string)
1142   "Display STRING in a new view buffer on click."
1143   (let ((buff (get-buffer-create
1144                "*Preview-Ghostscript-Error*")))
1145     (with-current-buffer buff
1146       (kill-all-local-variables)
1147       (set (make-local-variable 'view-exit-action) #'kill-buffer)
1148       (setq buffer-undo-list t)
1149       (erase-buffer)
1150       (insert string)
1151       (goto-char (point-min)))
1152     (view-buffer-other-window buff)))
1153
1154 (defun preview-mouse-open-eps (file &optional position)
1155   "Display eps FILE in a view buffer on click.
1156 Place point at POSITION, else beginning of file."
1157   (let ((default-major-mode
1158           (or
1159            (assoc-default "x.ps" auto-mode-alist #'string-match)
1160            default-major-mode))
1161         (buff (get-file-buffer file)))
1162     (save-excursion
1163       (if buff
1164           (pop-to-buffer buff)
1165         (view-file-other-window file))
1166       (goto-char (or position (point-min)))
1167       (if (eq major-mode 'ps-mode)          ; Bundled with GNU Emacs
1168           (message "%s" (substitute-command-keys "\
1169 Try \\[ps-run-start] \\[ps-run-buffer] and \
1170 \\<ps-run-mode-map>\\[ps-run-mouse-goto-error] on error offset." )))
1171       (if (eq major-mode 'postscript-mode) ; Bundled with XEmacs, limited
1172           (message "%s" (substitute-command-keys "\
1173 Try \\[ps-shell] and \\[ps-execute-buffer]."))))))
1174
1175 (defun preview-gs-flag-error (ov err)
1176   "Make an eps error flag in overlay OV for ERR string."
1177   (let* ((filenames (overlay-get ov 'filenames))
1178          (file (car (nth 0 filenames)))
1179          (outfile (format "-dOutputFile=%s"
1180                           (preview-ps-quote-filename
1181                            (car (nth 1 filenames)))))
1182          (ps-open
1183           `(lambda() (interactive "@")
1184              (preview-mouse-open-error
1185               ,(concat
1186                 (mapconcat #'shell-quote-argument
1187                             (append (list
1188                                      preview-gs-command
1189                                      outfile)
1190                                     preview-gs-command-line)
1191                             " ")
1192                  "\nGS>"
1193                  preview-gs-init-string
1194                  (aref (overlay-get ov 'queued) 1)
1195                  err))))
1196          (str
1197           (preview-make-clickable
1198            nil
1199            preview-error-icon
1200            "%s views error message
1201 %s more options"
1202            ps-open
1203            `(lambda() (interactive)
1204               (popup-menu
1205                '("PostScript error"
1206                  ["View error" ,ps-open]
1207                  ["View source"
1208                   (lambda () (interactive "@")
1209                     ,(if preview-ps-file
1210                          `(preview-mouse-open-eps
1211                            ,(if (consp (car file))
1212                                 (nth 1 (car file))
1213                               (car file))
1214                            ,(nth 0 (aref preview-gs-dsc
1215                                          (aref (overlay-get ov 'queued) 2))))
1216                        `(preview-mouse-open-eps ,file)))]))))))
1217     (overlay-put ov 'strings (cons str str))
1218     (preview-toggle ov)))
1219
1220 (defun preview-gs-transact (process answer)
1221   "Work off Ghostscript transaction.
1222 This routine is the action routine called via the process filter.
1223 The Ghostscript process buffer of PROCESS will already be selected, and
1224 and the standard output of Ghostscript up to the next prompt will be
1225 given as ANSWER."
1226   (let ((ov (pop preview-gs-outstanding))
1227         (have-error (not
1228                      (string-match "\\`GS\\(<[0-9]+\\)?>\\'" answer ))))
1229     (when (and ov (overlay-buffer ov))
1230       (let ((queued (overlay-get ov 'queued)))
1231         (when queued
1232           (let* ((bbox (aref queued 0))
1233                  (filenames (overlay-get ov 'filenames))
1234                  (oldfile (nth 0 filenames))
1235                  (newfile (nth 1 filenames)))
1236             (if have-error
1237                 (preview-gs-flag-error ov answer)
1238               (condition-case nil
1239                   (preview-delete-file oldfile)
1240                 (file-error nil))
1241               (overlay-put ov 'filenames (cdr filenames))
1242               (preview-replace-active-icon
1243                ov
1244                (preview-create-icon (car newfile)
1245                                     preview-gs-image-type
1246                                     (preview-ascent-from-bb
1247                                      bbox)
1248                                     (aref preview-colors 2))))
1249             (overlay-put ov 'queued nil)))))
1250     (while (and (< (length preview-gs-outstanding)
1251                    preview-gs-outstanding-limit)
1252                 (setq ov (pop preview-gs-queue)))
1253       (let ((queued (overlay-get ov 'queued)))
1254         (when (and queued
1255                    (not (memq ov preview-gs-outstanding))
1256                    (overlay-buffer ov))
1257           (let* ((filenames (overlay-get ov 'filenames))
1258                  (oldfile (car (nth 0
1259                                     (nconc filenames
1260                                            (list
1261                                             (preview-make-filename
1262                                              (format "pr%d-%d.%s"
1263                                                      (car preview-gs-sequence)
1264                                                      (cdr preview-gs-sequence)
1265                                                      preview-gs-image-type)
1266                                              TeX-active-tempdir))))))
1267                  (bbox (aset queued 0
1268                              (or (and preview-prefer-TeX-bb
1269                                       (aref queued 0))
1270                                  (and (stringp oldfile)
1271                                       (preview-extract-bb
1272                                        oldfile))
1273                                  (aref queued 0)
1274                                  (error "No bounding box"))))
1275                  (snippet (aref queued 2))
1276                  (gs-line
1277                   (format
1278                    "%s<<%s>>preview-do\n"
1279                    (if preview-ps-file
1280                        (concat "dup "
1281                                (preview-gs-dsc-cvx
1282                                 snippet
1283                                 preview-gs-dsc))
1284                      (format "%s(r)file cvx"
1285                              (preview-ps-quote-filename
1286                               (if (listp oldfile)
1287                                   (car (last oldfile))
1288                                 oldfile))))
1289                    (if preview-parsed-tightpage
1290                        ""
1291                      (format "/PageSize[%g %g]/PageOffset[%g \
1292 %g[1 1 dtransform exch]{0 ge{neg}if exch}forall]"
1293                              (- (aref bbox 2) (aref bbox 0))
1294                              (- (aref bbox 3) (aref bbox 1))
1295                              (aref bbox 0) (aref bbox 1))))))
1296             (setcdr preview-gs-sequence (1+ (cdr preview-gs-sequence)))
1297             (setq preview-gs-outstanding
1298                   (nconc preview-gs-outstanding
1299                          (list ov)))
1300             (aset queued 1 gs-line)
1301             ;; ignore errors because of dying processes: they will get
1302             ;; caught by the sentinel, anyway.
1303             (condition-case nil
1304                 (process-send-string
1305                  process
1306                  gs-line)
1307               (error nil))))))
1308     (unless preview-gs-outstanding
1309       (condition-case nil
1310           (process-send-eof process)
1311         (error nil)))))
1312
1313 (defun preview-hook-enquiry (hook)
1314   "Gets a value from a configured hook.
1315 HOOK is a list or single item, for which the first resolving to
1316 non-nil counts.  Entries can be a callable function, or
1317 a symbol that is consulted, or a value.  Lists are evaluated
1318 recursively."
1319   (cond ((functionp hook)
1320          (funcall hook))
1321         ((consp hook)
1322          (let (res)
1323            (while (and (not res) hook)
1324              (setq res (preview-hook-enquiry (car hook))
1325                    hook (cdr hook)))
1326            res))
1327         ((and (symbolp hook) (boundp hook))
1328          (symbol-value hook))
1329         (t hook)))
1330
1331 (defcustom preview-scale-function #'preview-scale-from-face
1332   "*Scale factor for included previews.
1333 This can be either a function to calculate the scale, or
1334 a fixed number."
1335   :group 'preview-appearance
1336   :type '(choice (function-item preview-scale-from-face)
1337                  (const 1.0)
1338                  (number :value 1.0)
1339                  (function :value preview-scale-from-face)))
1340
1341 (defcustom preview-default-document-pt 10
1342   "*Assumed document point size for `preview-scale-from-face'.
1343 If the point size (such as 11pt) of the document cannot be
1344 determined from the document options itself, assume this size.
1345 This is for matching screen font size and previews."
1346   :group 'preview-appearance
1347   :type
1348           '(choice (const :tag "10pt" 10)
1349                   (const :tag "11pt" 11)
1350                   (const :tag "12pt" 12)
1351                   (number :tag "Other" :value 11.0))
1352 )
1353
1354 (defcustom preview-document-pt-list '(preview-parsed-font-size
1355   preview-auctex-font-size
1356   preview-default-document-pt)
1357   "*How `preview-document-pt' figures out the document size."
1358   :group 'preview-appearance
1359   :type
1360   '(repeat (choice
1361             ;; This is a bug: type function seems to match variables, too.
1362             (restricted-sexp :match-alternatives (functionp)
1363                              :tag "Function" :value preview-auctex-font-size)
1364             (variable :value preview-parsed-font-size)
1365             (number :value 11))))
1366
1367 (defun preview-auctex-font-size ()
1368   "Calculate the default font size of document.
1369 If packages, classes or styles were called with an option
1370 like 10pt, size is taken from the first such option if you
1371 had let your document be parsed by AucTeX."
1372   (catch 'return (dolist (option (TeX-style-list))
1373                    (if (string-match "\\`\\([0-9]+\\)pt\\'" option)
1374                        (throw 'return
1375                               (string-to-number
1376                                (match-string 1 option)))))))
1377
1378 (defsubst preview-document-pt ()
1379   "Calculate the default font size of document."
1380   (preview-hook-enquiry preview-document-pt-list))
1381
1382 (defun preview-scale-from-face ()
1383   "Calculate preview scale from `preview-reference-face'.
1384 This calculates the scale of EPS images from a document assumed
1385 to have a default font size given by function `preview-document-pt'
1386 so that they match the reference face in height."
1387   `(lambda nil
1388      (/ ,(/ (preview-inherited-face-attribute 'preview-reference-face :height
1389                                               'default) 10.0)
1390         (preview-document-pt))))
1391
1392 (defvar preview-min-spec)
1393
1394 (defun preview-make-image (symbol)
1395   "Make an image from a preview spec list.
1396 The first spec that is workable (given the current setting of
1397 `preview-min-spec') from the given symbol is used here.  The
1398 icon is cached in the property list of the symbol."
1399   (let ((alist (get 'preview-min-alist symbol)))
1400     (cdr (or
1401           (assq preview-min-spec alist)
1402           (car (put symbol 'preview-min-alist
1403                     (cons
1404                      (cons preview-min-spec
1405                            (preview-filter-specs
1406                             (symbol-value symbol)))
1407                      alist)))))))
1408
1409 (defun preview-filter-specs (spec-list)
1410   "Find the first of the fitting specs and make an image."
1411   (let (image)
1412     (while (and spec-list
1413                 (not (setq image
1414                            (catch 'preview-filter-specs
1415                              (preview-filter-specs-1 (car spec-list))))))
1416       (setq spec-list (cdr spec-list)))
1417     image))
1418
1419 (defun preview-filter-specs-1 (specs)
1420   (and specs
1421        (if (get 'preview-filter-specs (car specs))
1422            (apply (get 'preview-filter-specs (car specs)) specs)
1423          `(,(nth 0 specs) ,(nth 1 specs)
1424            ,@(preview-filter-specs-1 (nthcdr 2 specs))))))
1425
1426 (put 'preview-filter-specs :min
1427      #'(lambda (keyword value &rest args)
1428          (if (> value preview-min-spec)
1429              (throw 'preview-filter-specs nil)
1430            (preview-filter-specs-1 args))))
1431
1432 (defvar preview-datadir (file-name-directory load-file-name)
1433   "The directory relative to which package data may be found.
1434 This should be hardwired into the startup file containing the
1435 autoloads for preview-latex.")
1436
1437 (put 'preview-filter-specs :file
1438      #'(lambda (keyword value &rest args)
1439          `(:file ,(expand-file-name value (expand-file-name "images"
1440                                                             preview-datadir))
1441                  ,@(preview-filter-specs-1 args))))
1442
1443 (defvar preview-lispdir TeX-lisp-directory
1444   "The directory where the preview lisp files are located.")
1445
1446 (defun preview-ascent-from-bb (bb)
1447   "This calculates the image ascent from its bounding box.
1448 The bounding box BB needs to be a 4-component vector of
1449 numbers (can be float if available)."
1450   ;; baseline is at 1in from the top of letter paper (11in), so it is
1451   ;; at 10in from the bottom precisely, which is 720 in PostScript
1452   ;; coordinates.  If our bounding box has its bottom not above this
1453   ;; line, and its top above, we can calculate a useful ascent value.
1454   ;; If not, something is amiss.  We just use 100 in that case.
1455
1456   (let ((bottom (aref bb 1))
1457         (top (aref bb 3)))
1458     (if (and (<= bottom 720)
1459              (> top 720))
1460         (round (* 100.0 (/ (- top 720.0) (- top bottom))))
1461       100)))
1462
1463 (defface preview-face '((((background dark))
1464                          (:background "dark slate gray"))
1465                         (t
1466                          (:background "beige")))
1467   "Face to use for the preview source."
1468   :group 'preview-appearance)
1469
1470 (defface preview-reference-face '((t nil))
1471   "Face consulted for colors and scale of active previews.
1472 Fallback to :inherit and 'default implemented."
1473   :group 'preview-appearance)
1474
1475 (defcustom preview-auto-reveal
1476   '(eval (preview-arrived-via (key-binding [left]) (key-binding [right])
1477                               'backward-char 'forward-char))
1478   "*Cause previews to open automatically when entered.
1479 Possibilities are:
1480 T autoopens,
1481 NIL doesn't,
1482 a symbol will have its value consulted if it exists,
1483 defaulting to NIL if it doesn't.
1484 An integer will specify a maximum cursor movement distance.
1485 Larger movements won't open the preview.
1486 A CONS-cell means to call a function for determining the value.
1487 The CAR of the cell is the function to call which receives
1488 the CDR of the CONS-cell in the rest of the arguments, while
1489 point and current buffer point to the position in question.
1490 All of the options show reasonable defaults."
1491   :group 'preview-appearance
1492   :type '(choice (const :tag "Off" nil)
1493                  (const :tag "On" t)
1494                  (symbol :tag "Indirect variable" :value reveal-mode)
1495                  (integer :tag "Maximum distance" :value 1)
1496                  (cons :tag "Function call"
1497                        :value (eval (preview-arrived-via
1498                                      (key-binding [left])
1499                                      (key-binding [right])))
1500                        function (list :tag "Argument list"
1501                                       (repeat :inline t sexp)))))
1502
1503 (defun preview-auto-reveal-p (mode distance)
1504   "Decide whether to auto-reveal.
1505 Returns non-NIL if region should be auto-opened.
1506 See `preview-auto-reveal' for definitions of MODE, which gets
1507 set to `preview-auto-reveal'.  DISTANCE specifies the movement
1508 distance with which point has been reached in case it has been
1509 a movement starting in the current buffer."
1510   (cond ((symbolp mode)
1511          (and (boundp mode)
1512               (symbol-value mode)))
1513         ((integerp mode)
1514          (and distance (/= 0 distance) (<= (abs distance) mode)))
1515         ((consp mode)
1516          (apply (car mode) (cdr mode)))
1517         (t mode)))
1518
1519 (defun preview-arrived-via (&rest list)
1520   "Indicate auto-opening.
1521 Returns non-NIL if called by one of the commands in LIST."
1522   (memq this-command list))
1523
1524 (defcustom preview-equality-transforms '(identity
1525                                          preview-canonical-spaces)
1526 "Transformation functions for region changes.
1527 These functions are tried in turn on the strings from the
1528 regions of a preview to decide whether a preview is to be considered
1529 changed.  If any transform leads to equal results, the preview is
1530 considered unchanged."
1531   :group 'preview-appearance
1532   :type '(repeat function))
1533
1534 (defun preview-relaxed-string= (&rest args)
1535 "Check for functional equality of arguments.
1536 The arguments ARGS are checked for equality by using
1537 `preview-equality-transforms' on them until it is exhausted
1538 or one transform returns equality."
1539   (let ((lst preview-equality-transforms))
1540     (while (and lst (not (apply #'string= (mapcar (car lst) args))))
1541       (setq lst (cdr lst)))
1542     lst))
1543
1544 (defun preview-canonical-spaces (arg)
1545   "Convert ARG into canonical form.
1546 Removes comments and collapses white space, except for multiple newlines."
1547   (let (pos)
1548     (while (setq pos (string-match "\\s<.*[\n\r][ \t]*" arg pos))
1549       (setq arg (replace-match "" t t arg 0)))
1550     (while (setq pos (string-match "[ \t]*\\(\\([ \t]\\)\\|[\n\r][ \t]*\\)"
1551                                    arg pos))
1552       (setq arg (replace-match (if (match-beginning 2) " " "\n") t t arg 0)
1553             pos (1+ pos)))
1554     (while (setq pos (string-match "\n+" arg pos))
1555       (if (string= "\n" (match-string 0 arg))
1556           (setq arg (replace-match " " t t arg 0)
1557                 pos (1+ pos))
1558         (setq pos (match-end 0)))))
1559   arg)
1560
1561 (defun preview-regenerate (ovr)
1562   "Pass the modified region in OVR again through LaTeX."
1563   (let ((begin (overlay-start ovr))
1564         (end (overlay-end ovr)))
1565     (with-current-buffer (overlay-buffer ovr)
1566       (preview-delete ovr)
1567       (preview-region begin end))))
1568
1569 (defcustom preview-inner-environments '("Bmatrix" "Vmatrix" "aligned"
1570                                         "array" "bmatrix" "cases"
1571                                         "gathered" "matrix" "pmatrix"
1572                                         "smallmatrix" "split"
1573                                         "subarray" "vmatrix")
1574   "Environments not to be previewed on their own."
1575   :group 'preview-latex
1576   :type '(repeat string))
1577
1578
1579 (defun preview-next-border (backwards)
1580   "Search for the next interesting border for `preview-at-point'.
1581 Searches backwards if BACKWARDS is non-nil."
1582   (let (history preview-state (pt (point)))
1583     (catch 'exit
1584       (while
1585           (null
1586            (memq
1587             (setq preview-state
1588                   (if backwards
1589                       (if (> (setq pt
1590                                    (previous-single-char-property-change
1591                                     pt 'preview-state)) (point-min))
1592                           (get-char-property (1- pt) 'preview-state)
1593                         (throw 'exit (or history (point-min))))
1594                     (if (< (setq pt
1595                                  (next-single-char-property-change
1596                                   pt 'preview-state)) (point-max))
1597                         (get-char-property pt 'preview-state)
1598                       (throw 'exit (or history (point-max))))))
1599             '(active inactive)))
1600         (setq history (and (not preview-state) pt)))
1601       (or history pt))))
1602
1603 (defun preview-at-point ()
1604   "Do the appropriate preview thing at point.
1605 If point is positioned on or inside of an unmodified preview area,
1606 its visibility is toggled.
1607
1608 If not, the surroundings are run through preview.  The
1609 surroundings don't extend into unmodified previews or past
1610 contiguous previews invalidated by modifications.
1611
1612 Overriding any other action, if a region is
1613 active (`transient-mark-mode' or `zmacs-regions'), it is run
1614 through `preview-region'."
1615   (interactive)
1616   (if (TeX-active-mark)
1617       (preview-region (region-beginning) (region-end))
1618     (catch 'exit
1619       (dolist (ovr (overlays-in (max (point-min) (1- (point)))
1620                                 (min (point-max) (1+ (point)))))
1621         (let ((preview-state (overlay-get ovr 'preview-state)))
1622           (when preview-state
1623             (unless (eq preview-state 'disabled)
1624               (preview-toggle ovr 'toggle (selected-window))
1625               (throw 'exit t)))))
1626       (preview-region (preview-next-border t)
1627                       (preview-next-border nil)))))
1628
1629 (defun preview-disabled-string (ov)
1630   "Generate a before-string for disabled preview overlay OV."
1631   (concat (preview-make-clickable
1632            (overlay-get ov 'preview-map)
1633            preview-icon
1634            "\
1635 %s regenerates preview
1636 %s more options"
1637            `(lambda() (interactive) (preview-regenerate ,ov)))
1638 ;; icon on separate line only for stuff starting on its own line
1639           (with-current-buffer (overlay-buffer ov)
1640             (save-excursion
1641               (save-restriction
1642                 (widen)
1643                 (goto-char (overlay-start ov))
1644                 (if (bolp) "\n" ""))))))
1645
1646 (defun preview-disable (ovr)
1647   "Change overlay behaviour of OVR after source edits."
1648   (overlay-put ovr 'queued nil)
1649   (preview-remove-urgentization ovr)
1650   (overlay-put ovr 'preview-image nil)
1651   (overlay-put ovr 'timestamp nil)
1652   (setcdr (overlay-get ovr 'strings) (preview-disabled-string ovr))
1653   (preview-toggle ovr)
1654   (overlay-put ovr 'preview-state 'disabled)
1655   (dolist (filename (overlay-get ovr 'filenames))
1656     (condition-case nil
1657         (preview-delete-file filename)
1658       (file-error nil))
1659     (overlay-put ovr 'filenames nil)))
1660
1661 (defun preview-delete (ovr &rest ignored)
1662   "Delete preview overlay OVR, taking any associated file along.
1663 IGNORED arguments are ignored, making this function usable as
1664 a hook in some cases"
1665   (let ((filenames (overlay-get ovr 'filenames)))
1666     (overlay-put ovr 'filenames nil)
1667     (delete-overlay ovr)
1668     (dolist (filename filenames)
1669       (condition-case nil
1670           (preview-delete-file filename)
1671         (file-error nil)))))
1672
1673 (defun preview-clearout (&optional start end timestamp)
1674   "Clear out all previews in the current region.
1675 When called interactively, the current region is used.
1676 Non-interactively, the region between START and END is
1677 affected.  Those two values default to the borders of
1678 the entire buffer.  If TIMESTAMP is non-nil, previews
1679 with a `timestamp' property of it are kept."
1680   (interactive "r")
1681   (dolist (ov (overlays-in (or start (point-min))
1682                            (or end (point-max))))
1683     (and (overlay-get ov 'preview-state)
1684          (not (and timestamp
1685                    (equal timestamp (overlay-get ov 'timestamp))))
1686          (preview-delete ov))))
1687
1688 (defun preview-clearout-buffer (&optional buffer)
1689   "Clearout BUFFER from previews, current buffer if nil."
1690   (interactive)
1691   (if buffer
1692       (with-current-buffer buffer (preview-clearout))
1693     (preview-clearout)))
1694
1695 (defun preview-clearout-section ()
1696   "Clearout previews from LaTeX section."
1697   (interactive)
1698   (save-excursion
1699     (LaTeX-mark-section)
1700     (preview-clearout (region-beginning) (region-end))))
1701
1702 (defun preview-clearout-at-point ()
1703   "Clearout any preview at point."
1704   (interactive)
1705   (preview-clearout (max (point-min) (1- (point)))
1706                     (min (point-max) (1+ (point)))))
1707
1708 (defun preview-walk-document (func)
1709   "Cycle through all buffers belonging to current document.
1710 Each buffer having the same master file as the current file
1711 has FUNC called with its current buffer being set to it."
1712   (let* ((buffers (buffer-list))
1713          (master (expand-file-name (TeX-master-file t)))
1714          (default-buffers (list (current-buffer)
1715                                 (find-buffer-visiting master))))
1716     (while buffers
1717       (with-current-buffer (pop buffers)
1718         (when
1719             (or (memq (current-buffer) default-buffers)
1720                 (and (memq major-mode '(plain-tex-mode latex-mode))
1721                      (or (stringp TeX-master)
1722                          (eq TeX-master t))
1723                      (string= (expand-file-name (TeX-master-file t))
1724                               master)))
1725           (funcall func))))))
1726
1727 (defun preview-clearout-document ()
1728   "Clear out all previews in current document.
1729 The document consists of all buffers that have the same master file
1730 as the current buffer.  This makes the current document lose
1731 all previews."
1732   (interactive)
1733   (preview-walk-document #'preview-clearout-buffer))
1734
1735 (defun preview-kill-buffer-cleanup (&optional buf)
1736   "This is a cleanup function just for use in hooks.
1737 Cleans BUF or current buffer.  The difference to
1738 `preview-clearout-buffer' is that previews
1739 associated with the last buffer modification time are
1740 kept."
1741   (with-current-buffer (or buf (current-buffer))
1742     (save-restriction
1743       (widen)
1744       (preview-clearout (point-min) (point-max) (visited-file-modtime)))))
1745
1746 (add-hook 'kill-buffer-hook #'preview-kill-buffer-cleanup)
1747 (add-hook 'before-revert-hook #'preview-kill-buffer-cleanup)
1748
1749 (defvar preview-last-counter)
1750
1751 (defun preview-extract-counters (ctr)
1752   (setq preview-last-counter
1753         (prog1 (copy-sequence ctr)
1754           (dolist (elt preview-last-counter)
1755             (setq ctr (delete elt ctr)))))
1756   (apply #'concat ctr))
1757
1758 (defun desktop-buffer-preview-misc-data (&rest ignored)
1759   "Hook function that extracts previews for persistent sessions."
1760   (unless (buffer-modified-p)
1761     (setq preview-last-counter nil)
1762     (save-restriction
1763       (widen)
1764       (let (save-info (timestamp (visited-file-modtime)))
1765         (dolist (ov (sort (overlays-in (point-min) (point-max))
1766                           (lambda (x y) (< (overlay-start x)
1767                                            (overlay-start y)))))
1768           (when (and (memq (overlay-get ov 'preview-state) '(active inactive))
1769                      (null (overlay-get ov 'queued))
1770                      (cdr (overlay-get ov 'preview-image)))
1771             (push (preview-dissect ov timestamp) save-info)))
1772         (and save-info
1773              (cons 'preview (cons timestamp (nreverse save-info))))))))
1774
1775 (eval-after-load "desktop"
1776   '(add-hook
1777     'desktop-buffer-misc-functions
1778     #'desktop-buffer-preview-misc-data))
1779
1780 (defvar preview-temp-dirs nil
1781 "List of top level temporary directories in use from preview.
1782 Any directory not in this list will be cleared out by preview
1783 on first use.")
1784
1785 (defun preview-dissect (ov timestamp)
1786   "Extract all persistent data from OV and TIMESTAMP it."
1787   (let ((filenames (butlast (nth 0 (overlay-get ov 'filenames)))))
1788     (overlay-put ov 'timestamp timestamp)
1789     (list (overlay-start ov)
1790           (overlay-end ov)
1791           (cdr (overlay-get ov 'preview-image))
1792           filenames
1793           (let ((ctr (overlay-get ov 'preview-counters)))
1794             (and ctr
1795                  (cons (preview-extract-counters (car ctr))
1796                        (preview-extract-counters (cdr ctr))))))))
1797
1798 (defun preview-buffer-restore-internal (buffer-misc)
1799   "Restore previews from BUFFER-MISC if proper.
1800 Remove them if they have expired."
1801   (let ((timestamp (visited-file-modtime)) tempdirlist files)
1802     (setq preview-parsed-counters nil)
1803     (when (eq 'preview (pop buffer-misc))
1804       (preview-get-geometry)
1805       (if (equal (pop buffer-misc) timestamp)
1806           (dolist (ovdata buffer-misc)
1807             (setq tempdirlist
1808                   (apply #'preview-reinstate-preview tempdirlist
1809                          timestamp ovdata)))
1810         (dolist (ovdata buffer-misc)
1811           (setq files (nth 3 ovdata))
1812           (condition-case nil
1813               (delete-file (nth 0 files))
1814             (file-error nil))
1815           (unless (member (nth 1 files) tempdirlist)
1816             (push (nth 1 files) tempdirlist)))
1817         (dolist (dir tempdirlist)
1818           (condition-case nil
1819               (delete-directory dir)
1820             (file-error nil)))))))
1821
1822
1823 (defun preview-buffer-restore (buffer-misc)
1824   "At end of desktop load, reinstate previews.
1825 This delay is so that minor modes changing buffer positions
1826 \(like `x-symbol-mode' does) will not wreak havoc.
1827 BUFFER-MISC is the appropriate data to be used."
1828   (add-hook 'desktop-delay-hook `(lambda ()
1829                                    (with-current-buffer ,(current-buffer)
1830                                      (preview-buffer-restore-internal
1831                                       ',buffer-misc)))))
1832
1833 (defun desktop-buffer-preview (desktop-buffer-file-name
1834                                desktop-buffer-name
1835                                desktop-buffer-misc)
1836   "Hook function for restoring persistent previews into a buffer."
1837   (when (and desktop-buffer-file-name
1838              (file-readable-p desktop-buffer-file-name))
1839     (let ((buf (find-file-noselect desktop-buffer-file-name)))
1840       (if (eq (car desktop-buffer-misc) 'preview)
1841           (with-current-buffer buf
1842             (preview-buffer-restore desktop-buffer-misc)
1843             buf)
1844         buf))))
1845
1846 (eval-after-load "desktop"
1847   '(if (boundp 'desktop-buffer-mode-handlers)
1848        (add-to-list 'desktop-buffer-mode-handlers
1849                     '(latex-mode . desktop-buffer-preview))
1850      (add-hook 'desktop-buffer-handlers '(lambda ()
1851                                            (desktop-buffer-preview
1852                                             desktop-buffer-file-name
1853                                             desktop-buffer-name
1854                                             desktop-buffer-misc)))))
1855
1856 (defcustom preview-auto-cache-preamble 'ask
1857   "*Whether to generate a preamble cache format automatically.
1858 Possible values are nil, t, and `ask'."
1859   :group 'preview-latex
1860   :type '(choice (const :tag "Cache" t)
1861                  (const :tag "Don't cache" nil)
1862                  (const :tag "Ask" ask)))
1863
1864 (defvar preview-dumped-alist nil
1865   "Alist of dumped masters.
1866 The elements are (NAME . ASSOC).  NAME is the master file name
1867 \(without extension), ASSOC is what to do with regard to this
1868 format.  Possible values: NIL means no format is available
1869 and none should be generated.  T means no format is available,
1870 it should be generated on demand.  If the value is a cons cell,
1871 the CAR of the cons cell is the command with which the format
1872 has been generated, and the CDR is some Emacs-flavor specific
1873 value used for maintaining a watch on possible changes of the
1874 preamble.")
1875
1876 (defun preview-cleanout-tempfiles ()
1877   "Clean out all directories and files with non-persistent data.
1878 This is called as a hook when exiting Emacs."
1879   (mapc #'preview-kill-buffer-cleanup (buffer-list))
1880   (mapc #'preview-format-kill preview-dumped-alist))
1881
1882 (defun preview-inactive-string (ov)
1883   "Generate before-string for an inactive preview overlay OV.
1884 This is for overlays where the source text has been clicked
1885 visible.  For efficiency reasons it is expected that the buffer
1886 is already selected and unnarrowed."
1887   (concat
1888    (preview-make-clickable (overlay-get ov 'preview-map)
1889                            preview-icon
1890                            "\
1891 %s redisplays preview
1892 %s more options")
1893 ;; icon on separate line only for stuff starting on its own line
1894    (with-current-buffer (overlay-buffer ov)
1895      (save-excursion
1896        (save-restriction
1897          (widen)
1898          (goto-char (overlay-start ov))
1899          (if (bolp) "\n" ""))))))
1900
1901 (defun preview-dvipng-place-all ()
1902   "Place all images dvipng has created, if any.
1903 Deletes the dvi file when finished."
1904   (let (filename queued oldfiles snippet)
1905     (dolist (ov (prog1 preview-gs-queue (setq preview-gs-queue nil)))
1906       (when (and (setq queued (overlay-get ov 'queued))
1907                  (setq snippet (aref (overlay-get ov 'queued) 2))
1908                  (setq filename (preview-make-filename
1909                                  (format "prev%03d.%s"
1910                                          snippet preview-dvipng-image-type)
1911                                  TeX-active-tempdir)))
1912         (if (file-exists-p (car filename))
1913             (progn
1914               (overlay-put ov 'filenames (list filename))
1915               (preview-replace-active-icon
1916                ov
1917                (preview-create-icon (car filename)
1918                                     preview-dvipng-image-type
1919                                     (preview-ascent-from-bb
1920                                      (aref queued 0))
1921                                     (aref preview-colors 2)))
1922               (overlay-put ov 'queued nil))
1923           (push filename oldfiles)
1924           (overlay-put ov 'filenames nil)
1925           (push ov preview-gs-queue))))
1926     (if (setq preview-gs-queue (nreverse preview-gs-queue))
1927         (progn
1928           (preview-start-dvips preview-fast-conversion)
1929           (setq TeX-sentinel-function (lambda (process command)
1930                                         (preview-gs-dvips-sentinel
1931                                          process
1932                                          command
1933                                          t)))
1934           (dolist (ov preview-gs-queue)
1935             (setq snippet (aref (overlay-get ov 'queued) 2))
1936             (overlay-put ov 'filenames
1937                          (list
1938                           (preview-make-filename
1939                            (or preview-ps-file
1940                                (format "preview.%03d" snippet))
1941                            TeX-active-tempdir))))
1942           (while (setq filename (pop oldfiles))
1943             (condition-case nil
1944                 (preview-delete-file filename)
1945               (file-error nil))))
1946       (condition-case nil
1947           (let ((gsfile preview-gs-file))
1948             (delete-file
1949              (with-current-buffer TeX-command-buffer
1950                (funcall (car gsfile) "dvi"))))
1951         (file-error nil)))))
1952
1953 (defun preview-active-string (ov)
1954   "Generate before-string for active image overlay OV."
1955   (preview-make-clickable
1956    (overlay-get ov 'preview-map)
1957    (car (overlay-get ov 'preview-image))
1958    "%s opens text
1959 %s more options"))
1960
1961 (defun preview-make-filename (file tempdir)
1962   "Generate a preview filename from FILE and TEMPDIR.
1963 Filenames consist of a CONS-cell with absolute file name as CAR
1964 and TEMPDIR as CDR.  TEMPDIR is a copy of `TeX-active-tempdir'
1965 with the directory name, the reference count and its top directory
1966 name elements.  If FILE is already in that form, the file name itself
1967 gets converted into a CONS-cell with a name and a reference count."
1968   (if (consp file)
1969       (progn
1970         (if (consp (car file))
1971             (setcdr (car file) (1+ (cdr (car file))))
1972           (setcar file (cons (car file) 1)))
1973         file)
1974     (setcar (nthcdr 2 tempdir) (1+ (nth 2 tempdir)))
1975     (cons (expand-file-name file (nth 0 tempdir))
1976           tempdir)))
1977
1978 (defun preview-attach-filename (attached file)
1979   "Attaches the absolute file name ATTACHED to FILE."
1980   (if (listp (caar file))
1981       (setcar (car file) (cons attached (caar file)))
1982     (setcar (car file) (list attached (caar file))))
1983   file)
1984
1985 (defun preview-delete-file (file)
1986   "Delete a preview FILE.
1987 See `preview-make-filename' for a description of the data
1988 structure.  If the containing directory becomes empty,
1989 it gets deleted as well."
1990   (let ((filename
1991          (if (consp (car file))
1992              (and (zerop
1993                    (setcdr (car file) (1- (cdr (car file)))))
1994                   (car (car file)))
1995            (car file))))
1996     (if filename
1997         (unwind-protect
1998             (if (listp filename)
1999                 (dolist (elt filename) (delete-file elt))
2000               (delete-file filename))
2001           (let ((tempdir (cdr file)))
2002             (when tempdir
2003               (if (> (nth 2 tempdir) 1)
2004                   (setcar (nthcdr 2 tempdir) (1- (nth 2 tempdir)))
2005                 (setcdr file nil)
2006                 (delete-directory (nth 0 tempdir)))))))))
2007
2008 (defvar preview-buffer-has-counters nil)
2009 (make-variable-buffer-local 'preview-buffer-has-counters)
2010
2011 (defun preview-place-preview (snippet start end
2012                                       box counters tempdir place-opts)
2013   "Generate and place an overlay preview image.
2014 This generates the filename for the preview
2015 snippet SNIPPET in the current buffer, and uses it for the
2016 region between START and END.  BOX is an optional preparsed
2017 TeX bounding BOX passed on to the `place' hook.
2018 COUNTERS is the info about saved counter structures.
2019 TEMPDIR is a copy of `TeX-active-tempdir'.
2020 PLACE-OPTS are additional arguments passed into
2021 `preview-parse-messages'.  Returns
2022 a list with additional info from the placement hook.
2023 Those lists get concatenated together and get passed
2024 to the close hook."
2025   (preview-clearout start end tempdir)
2026   (let ((ov (make-overlay start end nil nil nil)))
2027     (when (fboundp 'TeX-overlay-prioritize)
2028       (overlay-put ov 'priority (TeX-overlay-prioritize start end)))
2029     (overlay-put ov 'preview-map
2030                  (preview-make-clickable
2031                   nil nil nil
2032                   `(lambda(event) (interactive "e")
2033                      (preview-toggle ,ov 'toggle event))
2034                   `(lambda(event) (interactive "e")
2035                      (preview-context-menu ,ov event))))
2036     (overlay-put ov 'timestamp tempdir)
2037     (when (cdr counters)
2038       (overlay-put ov 'preview-counters counters)
2039       (setq preview-buffer-has-counters t))
2040     (prog1 (apply #'preview-call-hook 'place ov snippet box
2041                   place-opts)
2042       (overlay-put ov 'strings
2043                    (list (preview-active-string ov)))
2044       (preview-toggle ov t))))
2045
2046 ;; The following is a brutal hack.  It relies on `begin' being let to
2047 ;; the start of the interesting area when TeX-region-create is being
2048 ;; called.
2049
2050 (defun preview-counter-find (begin)
2051   "Fetch the next preceding or next preview-counters property.
2052 Factored out because of compatibility macros XEmacs would
2053 not use in advice."
2054   ;; The following two lines are bug workaround for Emacs < 22.1.
2055   (if (markerp begin)
2056       (setq begin (marker-position begin)))
2057   (or (car (get-char-property begin 'preview-counters))
2058       (cdr (get-char-property (max (point-min)
2059                                    (1- begin))
2060                               'preview-counters))
2061       (cdr (get-char-property
2062             (max (point-min)
2063                  (1- (previous-single-char-property-change
2064                       begin
2065                       'preview-counters)))
2066             'preview-counters))
2067       (car (get-char-property
2068             (next-single-char-property-change begin 'preview-counters)
2069             'preview-counters))))
2070
2071 (defadvice TeX-region-create (around preview-counters)
2072   "Write out counter information to region."
2073   (let ((TeX-region-extra
2074          (concat
2075           (and (boundp 'begin)
2076                preview-buffer-has-counters
2077                (mapconcat
2078                 #'identity
2079                 (cons
2080                  ""
2081                  (preview-counter-find (symbol-value 'begin)))
2082                 "\\setcounter"))
2083           TeX-region-extra)))
2084     ad-do-it))
2085
2086 (defun preview-reinstate-preview (tempdirlist timestamp start end
2087   image filename &optional counters)
2088   "Reinstate a single preview.
2089 This gets passed TEMPDIRLIST, a list consisting of the kind
2090 of entries used in `TeX-active-tempdir', and TIMESTAMP, the
2091 time stamp under which the file got read in.  It returns an augmented
2092 list.  START and END give the buffer location where the preview
2093 is to be situated, IMAGE the image to place there, and FILENAME
2094 the file to use: a triple consisting of filename, its temp directory
2095 and the corresponding topdir.  COUNTERS is saved counter information,
2096 if any."
2097   (when
2098       (or (null filename) (file-readable-p (car filename)))
2099     (when filename
2100       (unless (equal (nth 1 filename) (car TeX-active-tempdir))
2101         (setq TeX-active-tempdir
2102               (or (assoc (nth 1 filename) tempdirlist)
2103                   (car (push (append (cdr filename) (list 0))
2104                              tempdirlist))))
2105         (setcar (cdr TeX-active-tempdir)
2106                 (car (or (member (nth 1 TeX-active-tempdir)
2107                                  preview-temp-dirs)
2108                          (progn
2109                            (add-hook 'kill-emacs-hook
2110                                      #'preview-cleanout-tempfiles t)
2111                            (push (nth 1 TeX-active-tempdir)
2112                                  preview-temp-dirs))))))
2113       (setcar (nthcdr 2 TeX-active-tempdir)
2114               (1+ (nth 2 TeX-active-tempdir)))
2115       (setcdr filename TeX-active-tempdir)
2116       (setq filename (list filename)))
2117     (let ((ov (make-overlay start end nil nil nil)))
2118       (when (fboundp 'TeX-overlay-prioritize)
2119         (overlay-put ov 'priority (TeX-overlay-prioritize start end)))
2120       (overlay-put ov 'preview-map
2121                    (preview-make-clickable
2122                     nil nil nil
2123                     `(lambda(event) (interactive "e")
2124                        (preview-toggle ,ov 'toggle event))
2125                     `(lambda(event) (interactive "e")
2126                        (preview-context-menu ,ov event))))
2127       (when counters
2128         (overlay-put
2129          ov 'preview-counters
2130          (cons
2131             (mapcar #'cdr
2132                     (if (string= (car counters) "")
2133                         preview-parsed-counters
2134                       (setq preview-parsed-counters
2135                             (preview-parse-counters (car counters)))))
2136             (mapcar #'cdr
2137                     (if (string= (cdr counters) "")
2138                         preview-parsed-counters
2139                       (setq preview-parsed-counters
2140                             (preview-parse-counters (cdr counters)))))))
2141         (setq preview-buffer-has-counters t))
2142       (overlay-put ov 'filenames filename)
2143       (overlay-put ov 'preview-image (cons (preview-import-image image)
2144                                            image))
2145       (overlay-put ov 'strings
2146                    (list (preview-active-string ov)))
2147       (overlay-put ov 'timestamp timestamp)
2148       (preview-toggle ov t)))
2149   tempdirlist)
2150
2151 (defun preview-back-command (&optional nocomplex)
2152   "Move backward a TeX token.
2153 If NOCOMPLEX is set, only basic tokens and no argument sequences
2154 will be skipped over backwards."
2155   (let ((oldpos (point)) oldpoint)
2156     (condition-case nil
2157         (or (search-backward-regexp "\\(\\$\\$?\
2158 \\|\\\\[^a-zA-Z@]\
2159 \\|\\\\[a-zA-Z@]+\
2160 \\|\\\\begin[ \t]*{[^}]+}\
2161 \\)\\=" (line-beginning-position) t)
2162             nocomplex
2163             (if (eq ?\) (char-syntax (char-before)))
2164                 (while
2165                     (progn
2166                       (setq oldpoint (point))
2167                       (backward-sexp)
2168                       (and (not (eq oldpoint (point)))
2169                            (eq ?\( (char-syntax (char-after))))))
2170               (backward-char)))
2171       (error (goto-char oldpos)))))
2172
2173 (defcustom preview-required-option-list '("active" "tightpage" "auctex"
2174                                           (preview-preserve-counters
2175                                            "counters"))
2176   "Specifies required options passed to the preview package.
2177 These are passed regardless of whether there is an explicit
2178 \\usepackage of that package present."
2179   :group 'preview-latex
2180   :type preview-expandable-string)
2181
2182 (defcustom preview-preserve-counters nil
2183   "Try preserving counters for partial runs if set."
2184   :group 'preview-latex
2185   :type 'boolean)
2186
2187 (defcustom preview-default-option-list '("displaymath" "floats"
2188                                          "graphics" "textmath" "sections"
2189                                          "footnotes")
2190   "*Specifies default options to pass to preview package.
2191 These options are only used when the LaTeX document in question does
2192 not itself load the preview package, namely when you use preview
2193 on a document not configured for preview.  \"auctex\", \"active\",
2194 \"dvips\" and \"delayed\" need not be specified here."
2195   :group 'preview-latex
2196   :type '(list (set :inline t :tag "Options known to work"
2197                     :format "%t:\n%v%h" :doc
2198                     "The above options are all the useful ones
2199 at the time of the release of this package.
2200 You should not need \"Other options\" unless you
2201 upgraded to a fancier version of just the LaTeX style.
2202 Please also note that `psfixbb' fails to have an effect if
2203 `preview-fast-conversion' or `preview-prefer-TeX-bb'
2204 are selected."
2205                     (const "displaymath")
2206                     (const "floats")
2207                     (const "graphics")
2208                     (const "textmath")
2209                     (const "sections")
2210                     (const "footnotes")
2211                     (const "showlabels")
2212                     (const "psfixbb"))
2213                (set :tag "Expert options" :inline t
2214                     :format "%t:\n%v%h" :doc
2215                     "Expert options should not be enabled permanently."
2216                     (const "noconfig")
2217                     (const "showbox")
2218                     (const "tracingall"))
2219                (repeat :inline t :tag "Other options" (string))))
2220
2221 (defcustom preview-default-preamble
2222   '("\\RequirePackage[" ("," . preview-default-option-list)
2223                                       "]{preview}[2004/11/05]")
2224   "*Specifies default preamble code to add to a LaTeX document.
2225 If the document does not itself load the preview package, that is,
2226 when you use preview on a document not configured for preview, this
2227 list of LaTeX commands is inserted just before \\begin{document}."
2228   :group 'preview-latex
2229   :type preview-expandable-string)
2230
2231 (defcustom preview-LaTeX-command '("%`%l \"\\nonstopmode\\nofiles\
2232 \\PassOptionsToPackage{" ("," . preview-required-option-list) "}{preview}\
2233 \\AtBeginDocument{\\ifx\\ifPreview\\undefined"
2234 preview-default-preamble "\\fi}\"%' %t")
2235   "*Command used for starting a preview.
2236 See description of `TeX-command-list' for details."
2237   :group 'preview-latex
2238   :type preview-expandable-string)
2239
2240 (defun preview-goto-info-page ()
2241   "Read documentation for preview-latex in the info system."
2242   (interactive)
2243   (info "(preview-latex)"))
2244
2245 (eval-after-load 'info '(add-to-list 'Info-file-list-for-emacs
2246                                      '("preview" . "preview-latex")))
2247
2248 (defvar preview-map
2249   (let ((map (make-sparse-keymap)))
2250     (define-key map "\C-p" #'preview-at-point)
2251     (define-key map "\C-r" #'preview-region)
2252     (define-key map "\C-b" #'preview-buffer)
2253     (define-key map "\C-d" #'preview-document)
2254     (define-key map "\C-f" #'preview-cache-preamble)
2255     (define-key map "\C-c\C-f" #'preview-cache-preamble-off)
2256     (define-key map "\C-i" #'preview-goto-info-page)
2257     ;;  (define-key map "\C-q" #'preview-paragraph)
2258     (define-key map "\C-e" #'preview-environment)
2259     (define-key map "\C-s" #'preview-section)
2260     (define-key map "\C-w" #'preview-copy-region-as-mml)
2261     (define-key map "\C-c\C-p" #'preview-clearout-at-point)
2262     (define-key map "\C-c\C-r" #'preview-clearout)
2263     (define-key map "\C-c\C-s" #'preview-clearout-section)
2264     (define-key map "\C-c\C-b" #'preview-clearout-buffer)
2265     (define-key map "\C-c\C-d" #'preview-clearout-document)
2266     map))
2267
2268 (defun preview-copy-text (ov)
2269   "Copy the text of OV into the kill buffer."
2270   (save-excursion
2271     (set-buffer (overlay-buffer ov))
2272     (copy-region-as-kill (overlay-start ov) (overlay-end ov))))
2273
2274 (defun preview-copy-mml (ov)
2275   "Copy an MML representation of OV into the kill buffer.
2276 This can be used to send inline images in mail and news when
2277 using MML mode."
2278   (when (catch 'badcolor
2279           (let ((str (car (preview-format-mml ov))))
2280             (if str
2281                 (if (eq last-command 'kill-region)
2282                     (kill-append str nil)
2283                   (kill-new str))
2284               (error "No image file available")))
2285           nil)
2286     (let (preview-transparent-border)
2287       (preview-regenerate ov))))
2288
2289 (defun preview-copy-region-as-mml (start end)
2290   (interactive "r")
2291   (when (catch 'badcolor
2292           (let (str lst dont-ask)
2293             (dolist (ov (overlays-in start end))
2294               (when (setq str (preview-format-mml ov dont-ask))
2295                 (setq dont-ask (cdr str))
2296                 (and
2297                  (>= (overlay-start ov) start)
2298                  (<= (overlay-end ov) end)
2299                  (push (list (- (overlay-start ov) start)
2300                              (- (overlay-end ov) start)
2301                              (car str)) lst))))
2302             (setq str (buffer-substring start end))
2303             (dolist (elt (nreverse (sort lst #'car-less-than-car)))
2304               (setq str (concat (substring str 0 (nth 0 elt))
2305                                 (nth 2 elt)
2306                                 (substring str (nth 1 elt)))))
2307             (if (eq last-command 'kill-region)
2308                 (kill-append str nil)
2309               (kill-new str)))
2310           nil)
2311     (let (preview-transparent-border)
2312       (preview-region start end))))
2313
2314 (autoload 'mailcap-extension-to-mime "mailcap")
2315
2316 (defun preview-format-mml (ov &optional dont-ask)
2317   "Return an MML representation of OV as string.
2318 This can be used to send inline images in mail and news when
2319 using MML mode.  If there is nothing current available,
2320 NIL is returned.  If the image has a colored border and the
2321 user wants it removed when asked (unless DONT-ASK is set),
2322 'badcolor is thrown a t.  The MML is returned in the car of the
2323 result, DONT-ASK in the cdr."
2324   (and (memq (overlay-get ov 'preview-state) '(active inactive))
2325        (not (overlay-get ov 'queued))
2326        (let* ((text (with-current-buffer (overlay-buffer ov)
2327                      (buffer-substring (overlay-start ov)
2328                                        (overlay-end ov))))
2329               (image (cdr (overlay-get ov 'preview-image)))
2330               file type)
2331          (cond ((consp image)
2332                 (and (not dont-ask)
2333                      (nth 3 image)
2334                      (if (y-or-n-p "Replace colored borders? ")
2335                          (throw 'badcolor t)
2336                        (setq dont-ask t)))
2337                 (setq file (car (car (last (overlay-get ov 'filenames))))
2338                       type (mailcap-extension-to-mime
2339                             (file-name-extension file)))
2340                 (cons
2341                  (format "<#part %s
2342 description=\"%s\"
2343 filename=%s>
2344 <#/part>"
2345                          (if type
2346                              (format "type=\"%s\" disposition=inline" type)
2347                            "disposition=attachment")
2348                          (if (string-match "[\n\"]" text)
2349                              "preview-latex image"
2350                            text)
2351                          (if (string-match "[ \n<>]" file)
2352                              (concat "\"" file "\"")
2353                            file))
2354                  dont-ask))
2355                ((stringp image)
2356                 (cons image dont-ask))))))
2357
2358 (defun preview-active-contents (ov)
2359   "Check whether we have a valid image associated with OV."
2360   (and (memq (overlay-get ov 'preview-state) '(active inactive)) t))
2361
2362 (defun preview-context-menu (ov ev)
2363   "Pop up a menu for OV at position EV."
2364   (popup-menu
2365    `("Preview"
2366      ["Toggle" (preview-toggle ,ov 'toggle ',ev)
2367       (preview-active-contents ,ov)]
2368      ["Regenerate" (preview-regenerate ,ov)]
2369      ["Remove" (preview-delete ,ov)]
2370      ["Copy text" (preview-copy-text ,ov)]
2371      ["Copy MIME" (preview-copy-mml ,ov)
2372       (preview-active-contents ,ov)])
2373    ev))
2374
2375 (defvar preview-TeX-style-dir)
2376
2377 (defun preview-TeX-style-cooked ()
2378   "Return `preview-TeX-style-dir' in cooked form.
2379 This will be fine for prepending to a `TEXINPUT' style
2380 environment variable, including an initial `.' at the front."
2381   (if (or (zerop (length preview-TeX-style-dir))
2382           (member (substring preview-TeX-style-dir -1) '(";" ":")))
2383       preview-TeX-style-dir
2384     (let ((sep
2385            (cond
2386             ((stringp TeX-kpathsea-path-delimiter)
2387              TeX-kpathsea-path-delimiter)
2388             ((string-match
2389               "\\`.[:]"
2390               (if (file-name-absolute-p preview-TeX-style-dir)
2391                   preview-TeX-style-dir
2392                 (expand-file-name preview-TeX-style-dir)))
2393              ";")
2394             (t ":"))))
2395       (concat "." sep preview-TeX-style-dir sep))))
2396
2397 (defun preview-set-texinputs (&optional remove)
2398   "Add `preview-TeX-style-dir' into `TEXINPUTS' variables.
2399 With prefix argument REMOVE, remove it again."
2400   (interactive "P")
2401   (let ((case-fold-search nil)
2402         (preview-TeX-style-dir (preview-TeX-style-cooked))
2403         pattern)
2404     (if remove
2405         (progn
2406           (setq pattern (concat "\\`\\(TEXINPUTS[^=]*\\)=\\(.*\\)"
2407                                 (regexp-quote preview-TeX-style-dir)))
2408           (dolist (env (copy-sequence process-environment))
2409             (if (string-match pattern env)
2410                 (setenv (match-string 1 env)
2411                         (and (or (< (match-beginning 2) (match-end 2))
2412                                  (< (match-end 0) (length env)))
2413                              (concat (match-string 2 env)
2414                                      (substring env (match-end 0))))))))
2415       (setq pattern (regexp-quote preview-TeX-style-dir))
2416       (dolist (env (cons "TEXINPUTS=" (copy-sequence process-environment)))
2417         (if (string-match "\\`\\(TEXINPUTS[^=]*\\)=" env)
2418             (unless (string-match pattern env)
2419               (setenv (match-string 1 env)
2420                       (concat preview-TeX-style-dir
2421                               (substring env (match-end 0))))))))))
2422
2423 (defcustom preview-TeX-style-dir nil
2424   "This variable contains the location of uninstalled TeX styles.
2425 If this is nil, the preview styles are considered to be part of
2426 the installed TeX system.
2427
2428 Otherwise, it can either just specify an absolute directory, or
2429 it can be a complete TEXINPUTS specification.  If it is the
2430 latter, it has to be followed by the character with which
2431 kpathsea separates path components, either `:' on Unix-like
2432 systems, or `;' on Windows-like systems.  And it should be
2433 preceded with .: or .; accordingly in order to have . first in
2434 the search path.
2435
2436 The `TEXINPUT' environment type variables will get this prepended
2437 at load time calling \\[preview-set-texinputs] to reflect this.
2438 You can permanently install the style files using
2439 \\[preview-install-styles].
2440
2441 Don't set this variable other than with customize so that its
2442 changes get properly reflected in the environment."
2443   :group 'preview-latex
2444   :set (lambda (var value)
2445          (and (boundp var)
2446               (symbol-value var)
2447               (preview-set-texinputs t))
2448          (set var value)
2449          (and (symbol-value var)
2450               (preview-set-texinputs)))
2451   :type '(choice (const :tag "Installed" nil)
2452                  (string :tag "Style directory or TEXINPUTS path")))
2453
2454 ;;;###autoload
2455 (defun preview-install-styles (dir &optional force-overwrite
2456                                    force-save)
2457   "Installs the TeX style files into a permanent location.
2458 This must be in the TeX search path.  If FORCE-OVERWRITE is greater
2459 than 1, files will get overwritten without query, if it is less
2460 than 1 or nil, the operation will fail.  The default of 1 for interactive
2461 use will query.
2462
2463 Similarly FORCE-SAVE can be used for saving
2464 `preview-TeX-style-dir' to record the fact that the uninstalled
2465 files are no longer needed in the search path."
2466   (interactive "DPermanent location for preview TeX styles
2467 pp")
2468   (unless preview-TeX-style-dir
2469     (error "Styles are already installed"))
2470   (dolist (file (or
2471                  (condition-case nil
2472                      (directory-files
2473                       (progn
2474                         (string-match
2475                          "\\`\\(\\.[:;]\\)?\\(.*?\\)\\([:;]\\)?\\'"
2476                          preview-TeX-style-dir)
2477                         (match-string 2 preview-TeX-style-dir))
2478                       t "\\.\\(sty\\|def\\|cfg\\)\\'")
2479                    (error nil))
2480                  (error "Can't find files to install")))
2481     (copy-file file dir (cond ((eq force-overwrite 1) 1)
2482                               ((numberp force-overwrite)
2483                                (> force-overwrite 1))
2484                               (t force-overwrite))))
2485   (if (cond ((eq force-save 1)
2486              (y-or-n-p "Stop using non-installed styles permanently "))
2487             ((numberp force-save)
2488              (> force-save 1))
2489             (t force-save))
2490       (customize-save-variable 'preview-TeX-style-dir nil)
2491     (customize-set-variable 'preview-TeX-style-dir nil)))
2492
2493 ;;;###autoload
2494 (defun LaTeX-preview-setup ()
2495   "Hook function for embedding the preview package into AUCTeX.
2496 This is called by `LaTeX-mode-hook' and changes AUCTeX variables
2497 to add the preview functionality."
2498   (remove-hook 'LaTeX-mode-hook #'LaTeX-preview-setup)
2499   (add-hook 'LaTeX-mode-hook #'preview-mode-setup)
2500   (define-key LaTeX-mode-map "\C-c\C-p" preview-map)
2501   (easy-menu-define preview-menu LaTeX-mode-map
2502     "This is the menu for preview-latex."
2503     '("Preview"
2504       "Generate previews"
2505       ["(or toggle) at point" preview-at-point]
2506       ["for environment" preview-environment]
2507       ["for section" preview-section]
2508       ["for region" preview-region (preview-mark-active)]
2509       ["for buffer" preview-buffer]
2510       ["for document" preview-document]
2511       "---"
2512       "Remove previews"
2513       ["at point" preview-clearout-at-point]
2514       ["from section" preview-clearout-section]
2515       ["from region" preview-clearout (preview-mark-active)]
2516       ["from buffer" preview-clearout-buffer]
2517       ["from document" preview-clearout-document]
2518       "---"
2519       "Turn preamble cache"
2520       ["on" preview-cache-preamble]
2521       ["off" preview-cache-preamble-off]
2522       "---"
2523       ("Customize"
2524        ["Browse options"
2525         (customize-group 'preview)]
2526        ["Extend this menu"
2527         (easy-menu-add-item
2528          nil '("Preview")
2529          (customize-menu-create 'preview))])
2530       ["Read documentation" preview-goto-info-page]
2531       ["Report Bug" preview-report-bug]))
2532   (if (eq major-mode 'latex-mode)
2533       (preview-mode-setup))
2534   (if (boundp 'desktop-buffer-misc)
2535       (preview-buffer-restore desktop-buffer-misc)))
2536
2537 (defun preview-clean-subdir (dir)
2538   "Cleans out a temporary DIR with preview image files."
2539   (condition-case err
2540       (progn
2541         (mapc #'delete-file
2542               (directory-files dir t "\\`pr" t))
2543         (delete-directory dir))
2544     (error (message "Deletion of `%s' failed: %s" dir
2545                     (error-message-string err)))))
2546
2547 (defun preview-clean-topdir (topdir)
2548   "Cleans out TOPDIR from temporary directories.
2549 This does not erase the directory itself since its permissions
2550 might be needed for colloborative work on common files."
2551   (mapc #'preview-clean-subdir
2552         (condition-case nil
2553             (directory-files topdir t "\\`tmp" t)
2554           (file-error nil))))
2555
2556 (defun preview-create-subdirectory ()
2557   "Create a temporary subdir for the current TeX process.
2558 If necessary, generates a fitting top
2559 directory or cleans out an existing one (if not yet
2560 visited in this session), then returns the name of
2561 the created subdirectory relative to the master directory,
2562 in shell-quoted form.  `TeX-active-tempdir' is
2563 set to the corresponding TEMPDIR descriptor as described
2564 in `preview-make-filename'.  The directory is registered
2565 in `preview-temp-dirs' in order not to be cleaned out
2566 later while in use."
2567   (let ((topdir (expand-file-name (TeX-active-master "prv"))))
2568     (if (file-directory-p topdir)
2569         (unless (member topdir preview-temp-dirs)
2570           ;;  Cleans out the top preview directory by
2571           ;;  removing subdirs possibly left from a previous session.
2572           (preview-clean-topdir topdir)
2573           (push topdir preview-temp-dirs))
2574       (make-directory topdir)
2575       (add-to-list 'preview-temp-dirs topdir))
2576     (add-hook 'kill-emacs-hook #'preview-cleanout-tempfiles t)
2577     (setq TeX-active-tempdir
2578           (list (make-temp-file (expand-file-name
2579                            "tmp" (file-name-as-directory topdir)) t)
2580                 topdir
2581                 0))
2582     (shell-quote-argument
2583      (concat (file-name-as-directory (file-name-nondirectory topdir))
2584              (file-name-nondirectory (nth 0 TeX-active-tempdir))))))
2585
2586 ;; Hook into TeX immediately if it's loaded, use LaTeX-mode-hook if not.
2587 (if (featurep 'latex)
2588     (LaTeX-preview-setup)
2589   (add-hook 'LaTeX-mode-hook #'LaTeX-preview-setup))
2590
2591 ;;;###autoload (add-hook 'LaTeX-mode-hook #'LaTeX-preview-setup)
2592
2593 (defun preview-parse-counters (string)
2594   "Extract counter information from STRING."
2595   (let ((list preview-parsed-counters) (pos 0))
2596     (while (eq pos (string-match " *\\({\\([^{}]+\\)}{[-0-9]+}\\)" string pos))
2597       (setcdr (or (assoc (match-string 2 string) list)
2598                   (car (push (list (match-string 2 string)) list)))
2599               (match-string 1 string))
2600       (setq pos (match-end 1)))
2601     list))
2602
2603 (defun preview-parse-tightpage (string)
2604   "Build tightpage vector from STRING,"
2605   (read (concat "[" string "]")))
2606
2607 (defvar preview-parse-variables
2608   '(("Fontsize" preview-parsed-font-size
2609      "\\` *\\([0-9.]+\\)pt\\'" 1 string-to-number)
2610     ("Magnification" preview-parsed-magnification
2611      "\\` *\\([0-9]+\\)\\'" 1 string-to-number)
2612     ("PDFoutput" preview-parsed-pdfoutput
2613      "" 0 stringp)
2614     ("Counters" preview-parsed-counters
2615      ".*" 0 preview-parse-counters)
2616     ("Tightpage" preview-parsed-tightpage
2617      "\\` *\\(-?[0-9]+ *\\)\\{4\\}\\'" 0 preview-parse-tightpage)))
2618
2619 (defun preview-error-quote (string run-coding-system)
2620   "Turn STRING with potential ^^ sequences into a regexp.
2621 To preserve sanity, additional ^ prefixes are matched literally,
2622 so the character represented by ^^^ preceding extended characters
2623 will not get matched, usually."
2624   (let (output case-fold-search)
2625     (when (featurep 'mule)
2626       (setq string (encode-coding-string string run-coding-system)))
2627     (while (string-match "\\^\\{2,\\}\\(\\([@-_?]\\)\\|[8-9a-f][0-9a-f]\\)"
2628                          string)
2629       (setq output
2630             (concat output
2631                     (regexp-quote (substring string
2632                                              0
2633                                              (- (match-beginning 1) 2)))
2634                     (if (match-beginning 2)
2635                         (concat
2636                          "\\(?:" (regexp-quote
2637                                   (substring string
2638                                              (- (match-beginning 1) 2)
2639                                              (match-end 0)))
2640                          "\\|"
2641                          (char-to-string
2642                           (logxor (aref string (match-beginning 2)) 64))
2643                          "\\)")
2644                       (char-to-string
2645                        (string-to-number (match-string 1 string) 16))))
2646             string (substring string (match-end 0))))
2647     (setq output (concat output (regexp-quote string)))
2648     (if (featurep 'mule)
2649         (decode-coding-string output
2650                               (or (and (boundp 'TeX-japanese-process-output-coding-system)
2651                                        TeX-japanese-process-output-coding-system)
2652                                   buffer-file-coding-system))
2653       output)))
2654
2655 (defun preview-parse-messages (open-closure)
2656   "Turn all preview snippets into overlays.
2657 This parses the pseudo error messages from the preview
2658 document style for LaTeX.  OPEN-CLOSURE is called once
2659 it is certain that we have a valid output file, and it has
2660 to return in its CAR the PROCESS parameter for the CLOSE
2661 call, and in its CDR the final stuff for the placement hook."
2662   (with-temp-message "locating previews..."
2663     (let (TeX-error-file TeX-error-offset snippet box counters
2664           file line
2665           (lsnippet 0) lstart (lfile "") lline lbuffer lpoint
2666           lcounters
2667           string after-string error context-start
2668           context offset
2669           parsestate (case-fold-search nil)
2670           (run-buffer (current-buffer))
2671           (run-coding-system preview-coding-system)
2672           (run-directory default-directory)
2673           tempdir
2674           close-data
2675           open-data
2676           fast-hook
2677           slow-hook)
2678       ;; clear parsing variables
2679       (dolist (var preview-parse-variables)
2680         (set (nth 1 var) nil))
2681       (goto-char (point-min))
2682       (unwind-protect
2683           (progn
2684             (while
2685                 (re-search-forward "\
2686 ^\\(!\\|\\(.*?\\):[0-9]+:\\) \\|\
2687 \(\\(/*\
2688 \\(?:\\.+[^()\r\n{} /]*\\|[^()\r\n{} ./]+\
2689 \\(?: [^()\r\n{} ./]+\\)*\\(?:\\.[-0-9a-zA-Z_.]*\\)?\\)\
2690 \\(?:/+\\(?:\\.+[^()\r\n{} /]*\\|[^()\r\n{} ./]+\
2691 \\(?: [^()\r\n{} ./]+\\)*\\(?:\\.[-0-9a-zA-Z_.]*\\)?\\)?\\)*\\)\
2692 )*\\(?: \\|\r?$\\)\\|\
2693 \\()+\\)\\|\
2694  !\\(?:offset(\\([---0-9]+\\))\\|\
2695 name(\\([^)]+\\))\\)\\|\
2696 ^Preview: \\([a-zA-Z]+\\) \\([^\n\r]*\\)\r?$" nil t)
2697 ;;; Ok, here is a line by line breakdown:
2698 ;;; match-alternative 1:
2699 ;;; error indicator for TeX error, either style.
2700 ;;; match-alternative 2:
2701 ;;; The same, but file-line-error-style, matching on file name.
2702 ;;; match-alternative 3:
2703 ;;; Too ugly to describe in detail.  In short, we try to catch file
2704 ;;; names built from path components that don't contain spaces or
2705 ;;; other special characters once the file extension has started.
2706 ;;;
2707 ;;; Position for searching immediately after the file name so as to
2708 ;;; not miss closing parens or something.
2709 ;;; (match-string 3) is the file name.
2710 ;;; match-alternative 4:
2711 ;;; )+\( \|$\)
2712 ;;; a closing paren followed by the end of line or a space: a just
2713 ;;; closed file.
2714 ;;; match-alternative 5 (wrapped into one shy group with
2715 ;;; match-alternative 6, so that the match on first char is slightly
2716 ;;; faster):
2717 ;;; !offset(\([---0-9]+\))
2718 ;;; an AUCTeX offset message. (match-string 5) is the offset itself
2719 ;;; !name(\([^)]+\))
2720 ;;; an AUCTeX file name message.  (match-string 6) is the file name
2721 ;;; TODO: Actually, the latter two should probably again match only
2722 ;;; after a space or newline, since that it what \message produces.
2723 ;;;disabled in prauctex.def:
2724 ;;;\(?:Ov\|Und\)erfull \\.*[0-9]*--[0-9]*
2725 ;;;\(?:.\{79\}
2726 ;;;\)*.*$\)\|
2727 ;;; This would have caught overfull box messages that consist of
2728 ;;; several lines of context all with 79 characters in length except
2729 ;;; of the last one.  prauctex.def kills all such messages.
2730               (setq file (match-string-no-properties 2))
2731               (cond
2732                ((match-beginning 1)
2733                 (if (looking-at "\
2734 \\(?:Preview\\|Package Preview Error\\): Snippet \\([---0-9]+\\) \\(started\\|ended\\(\
2735 \\.? *(\\([---0-9]+\\)\\+\\([---0-9]+\\)x\\([---0-9]+\\))\\)?\\)\\.")
2736                     (progn
2737                       (when file
2738                         (unless TeX-error-file
2739                           (push nil TeX-error-file)
2740                           (push nil TeX-error-offset))
2741                         (unless (car TeX-error-offset)
2742                           (rplaca TeX-error-file file)))
2743                       (setq snippet (string-to-number (match-string 1))
2744                             box (unless
2745                                     (string= (match-string 2) "started")
2746                                   (if (match-string 4)
2747                                       (mapcar #'(lambda (x)
2748                                                   (* (preview-get-magnification)
2749                                                      (string-to-number x)))
2750                                               (list
2751                                                (match-string 4)
2752                                                (match-string 5)
2753                                                (match-string 6)))
2754                                     t))
2755                             counters (mapcar #'cdr preview-parsed-counters)
2756                             error (progn
2757                                     (setq lpoint (point))
2758                                     (end-of-line)
2759                                     (buffer-substring lpoint (point)))
2760
2761                             ;; And the context for the help window.
2762                             context-start (point)
2763
2764                             ;; And the line number to position the cursor.
2765 ;;; variant 1: profiling seems to indicate the regexp-heavy solution
2766 ;;; to be favorable.  Removing incomplete characters from the error
2767 ;;; context is an absolute nuisance.
2768                             line (and (re-search-forward "\
2769 ^l\\.\\([0-9]+\\) \\(\\.\\.\\.\\(?:\\^*\\(?:[89a-f][0-9a-f]\\|[]@-\\_?]\\)\\|\
2770 \[0-9a-f]?\\)\\)?\\([^\n\r]*?\\)\r?
2771 \\([^\n\r]*?\\)\\(\\(?:\\^+[89a-f]?\\)?\\.\\.\\.\\)?\r?$" nil t)
2772                                       (string-to-number (match-string 1)))
2773                             ;; And a string of the context to search for.
2774                             string (and line (match-string 3))
2775                             after-string (and line (buffer-substring
2776                                                     (+ (match-beginning 4)
2777                                                        (- (match-end 3)
2778                                                           (match-beginning 0)))
2779                                                     (match-end 4)))
2780
2781                             ;; And we have now found to the end of the context.
2782                             context (buffer-substring context-start (point))
2783                             ;; We may use these in another buffer.
2784                             offset (or (car TeX-error-offset) 0)
2785                             file (car TeX-error-file))
2786                       (when (and (stringp file)
2787                                  (or (string= file "<none>")
2788                                      (TeX-match-extension file)))
2789                         ;; if we are the first time round, check for fast hooks:
2790                         (when (null parsestate)
2791                           (setq open-data
2792                                 (save-excursion (funcall open-closure))
2793                                 tempdir TeX-active-tempdir)
2794                           (dolist
2795                               (lst (if (listp TeX-translate-location-hook)
2796                                        TeX-translate-location-hook
2797                                      (list TeX-translate-location-hook)))
2798                             (let ((fast
2799                                    (and (symbolp lst)
2800                                         (get lst 'TeX-translate-via-list))))
2801                               (if fast
2802                                   (setq fast-hook
2803                                         (nconc fast-hook (list fast)))
2804                                 (setq slow-hook
2805                                       (nconc slow-hook (list lst)))))))
2806                         (condition-case err
2807                             (save-excursion (run-hooks 'slow-hook))
2808                           (error (preview-log-error err "Translation hook")))
2809                         (push (vector file (+ line offset)
2810                                       string after-string
2811                                       snippet box counters) parsestate)))
2812                   ;; else normal error message
2813                   (forward-line)
2814                   (re-search-forward "^l\\.[0-9]" nil t)
2815                   (forward-line 2)))
2816                ((match-beginning 3)
2817                 ;; New file -- Push on stack
2818                 (push (match-string-no-properties 3) TeX-error-file)
2819                 (push nil TeX-error-offset)
2820                 (goto-char (match-end 3)))
2821                ((match-beginning 4)
2822                 ;; End of file -- Pop from stack
2823                 (when (> (length TeX-error-file) 1)
2824                   (pop TeX-error-file)
2825                   (pop TeX-error-offset))
2826                 (goto-char (1+ (match-beginning 0))))
2827                ((match-beginning 5)
2828                 ;; Hook to change line numbers
2829                 (setq TeX-error-offset
2830                       (list (string-to-number (match-string 5)))))
2831                ((match-beginning 6)
2832                 ;; Hook to change file name
2833                 (setq TeX-error-file (list (match-string-no-properties 6))))
2834                ((match-beginning 7)
2835                 (let ((var
2836                        (assoc (match-string-no-properties 7)
2837                               preview-parse-variables))
2838                       (offset (- (match-beginning 0) (match-beginning 8)))
2839                       (str (match-string-no-properties 8)))
2840                   ;; paste together continuation lines:
2841                   (while (= (- (length str) offset) 79)
2842                     (search-forward-regexp "^\\([^\n\r]*\\)\r?$")
2843                     (setq offset (- (length str))
2844                           str (concat str (match-string-no-properties 1))))
2845                   (when (and var
2846                              (string-match (nth 2 var) str))
2847                     (set (nth 1 var)
2848                          (funcall (nth 4 var)
2849                                   (match-string-no-properties
2850                                    (nth 3 var)
2851                                    str))))))))
2852             (when (null parsestate)
2853               (error "LaTeX found no preview images")))
2854         (unwind-protect
2855             (save-excursion
2856               (setq parsestate (nreverse parsestate))
2857               (condition-case err
2858                   (dolist (fun fast-hook)
2859                     (setq parsestate
2860                           (save-excursion (funcall fun parsestate))))
2861                 (error (preview-log-error err "Fast translation hook")))
2862               (setq snippet 0)
2863               (dolist (state parsestate)
2864                 (setq lsnippet snippet
2865                       file (aref state 0)
2866                       line (aref state 1)
2867                       string (aref state 2)
2868                       after-string (aref state 3)
2869                       snippet (aref state 4)
2870                       box (aref state 5)
2871                       counters (aref state 6))
2872                 (unless (string= lfile file)
2873                   (set-buffer (if (string= file "<none>")
2874                                   (with-current-buffer run-buffer
2875                                     TeX-command-buffer)
2876                                 (find-file-noselect
2877                                  (expand-file-name file run-directory))))
2878                   (setq lfile file))
2879                 (save-excursion
2880                   (save-restriction
2881                     (widen)
2882                     ;; a fast hook might have positioned us already:
2883                     (if (number-or-marker-p string)
2884                         (progn
2885                           (goto-char string)
2886                           (setq lpoint
2887                                 (if (number-or-marker-p after-string)
2888                                     after-string
2889                                   (line-beginning-position))))
2890                       (if (and (eq (current-buffer) lbuffer)
2891                                (<= lline line))
2892                           ;; while Emacs does the perfectly correct
2893                           ;; thing even when when the line differences
2894                           ;; get zero or negative, I don't trust this
2895                           ;; to be universally the case across other
2896                           ;; implementations.  Besides, if the line
2897                           ;; number gets smaller again, we are probably
2898                           ;; rereading the file, and restarting from
2899                           ;; the beginning will probably be faster.
2900                           (progn
2901                             (goto-char lpoint)
2902                             (if (/= lline line)
2903                                 (if (eq selective-display t)
2904                                     (re-search-forward "[\n\C-m]" nil
2905                                                        'end
2906                                                        (- line lline))
2907                                   (forward-line (- line lline)))))
2908                         (goto-line line))
2909                       (setq lpoint (point))
2910                       (cond
2911                        ((search-forward (concat string after-string)
2912                                         (line-end-position) t)
2913                         (backward-char (length after-string)))
2914                        ;;ok, transform ^^ sequences
2915                        ((search-forward-regexp
2916                          (concat "\\("
2917                                  (setq string
2918                                        (preview-error-quote
2919                                         string
2920                                         run-coding-system))
2921                                  "\\)"
2922                                  (setq after-string
2923                                        (preview-error-quote
2924                                         after-string
2925                                         run-coding-system)))
2926                          (line-end-position) t)
2927                         (goto-char (match-end 1)))
2928                        ((search-forward-regexp
2929                          (concat "\\("
2930                                  (if (string-match
2931                                       "^[^\0-\177]\\{1,6\\}" string)
2932                                      (setq string
2933                                            (substring string (match-end 0)))
2934                                    string)
2935                                  "\\)"
2936                                  (if (string-match
2937                                       "[^\0-\177]\\{1,6\\}$" after-string)
2938                                      (setq after-string
2939                                            (substring after-string
2940                                                       0 (match-beginning 0)))))
2941                          (line-end-position) t)
2942                         (goto-char (match-end 1)))
2943                        (t (search-forward-regexp
2944                            string
2945                            (line-end-position) t))))
2946                     (setq lline line
2947                           lbuffer (current-buffer))
2948                     (if box
2949                         (progn
2950                           (if (and lstart (= snippet lsnippet))
2951                               (setq close-data
2952                                     (nconc
2953                                      (preview-place-preview
2954                                       snippet
2955                                       (save-excursion
2956                                         (preview-back-command
2957                                          (= (prog1 (point)
2958                                               (goto-char lstart))
2959                                             lstart))
2960                                         (point))
2961                                       (point)
2962                                       (preview-TeX-bb box)
2963                                       (cons lcounters counters)
2964                                       tempdir
2965                                       (cdr open-data))
2966                                      close-data))
2967                             (with-current-buffer run-buffer
2968                               (preview-log-error
2969                                (list 'error
2970                                      (format
2971                                       "End of Preview snippet %d unexpected"
2972                                       snippet)) "Parser")))
2973                           (setq lstart nil))
2974                       ;; else-part of if box
2975                       (setq lstart (point) lcounters counters)
2976                       ;; >= because snippets in between might have
2977                       ;; been ignored because of TeX-default-extension
2978                       (unless (>= snippet (1+ lsnippet))
2979                         (with-current-buffer run-buffer
2980                           (preview-log-error
2981                            (list 'error
2982                                  (format
2983                                   "Preview snippet %d out of sequence"
2984                                   snippet)) "Parser"))))))))
2985           (preview-call-hook 'close (car open-data) close-data))))))
2986
2987 (defun preview-get-geometry ()
2988   "Transfer display geometry parameters from current display.
2989 Returns list of scale, resolution and colors.  Calculation
2990 is done in current buffer."
2991   (condition-case err
2992       (let* ((geometry
2993               (list (preview-hook-enquiry preview-scale-function)
2994                     (cons (/ (* 25.4 (display-pixel-width))
2995                              (display-mm-width))
2996                           (/ (* 25.4 (display-pixel-height))
2997                              (display-mm-height)))
2998                     (preview-get-colors)))
2999              (preview-min-spec
3000               (* (cdr (nth 1 geometry))
3001                  (/
3002                   (preview-inherited-face-attribute
3003                    'preview-reference-face :height 'default)
3004                   720.0))))
3005         (setq preview-icon (preview-make-image 'preview-icon-specs)
3006               preview-error-icon (preview-make-image
3007                                   'preview-error-icon-specs)
3008               preview-nonready-icon (preview-make-image
3009                                      'preview-nonready-icon-specs))
3010         geometry)
3011     (error (error "Display geometry unavailable: %s"
3012                   (error-message-string err)))))
3013
3014 (defun preview-set-geometry (geometry)
3015   "Set geometry variables from GEOMETRY.
3016 Buffer-local `preview-scale', `preview-resolution',
3017 and `preview-colors' are set as given."
3018   (setq preview-scale (nth 0 geometry)
3019         preview-resolution (nth 1 geometry)
3020         preview-colors (nth 2 geometry)))
3021
3022 (defun preview-start-dvipng ()
3023   "Start a DviPNG process.."
3024   (let* ((file preview-gs-file)
3025          tempdir
3026          (res (/ (* (car preview-resolution)
3027                     (preview-hook-enquiry preview-scale))
3028                  (preview-get-magnification)))
3029          (resolution  (format " -D%d " res))
3030          (colors (preview-dvipng-color-string preview-colors res))
3031          (command (with-current-buffer TeX-command-buffer
3032                     (prog1
3033                         (concat (TeX-command-expand preview-dvipng-command
3034                                                     (car file))
3035                                 " " colors resolution)
3036                       (setq tempdir TeX-active-tempdir))))
3037          (name "Preview-DviPNG"))
3038     (setq TeX-active-tempdir tempdir)
3039     (goto-char (point-max))
3040     (insert-before-markers "Running `" name "' with ``" command "''\n")
3041     (setq mode-name name)
3042     (setq TeX-sentinel-function
3043           (lambda (process name) (message "%s: done." name)))
3044     (if TeX-process-asynchronous
3045         (let ((process (start-process name (current-buffer) TeX-shell
3046                                       TeX-shell-command-option
3047                                       command)))
3048           (if TeX-after-start-process-function
3049               (funcall TeX-after-start-process-function process))
3050           (TeX-command-mode-line process)
3051           (set-process-filter process 'TeX-command-filter)
3052           (set-process-sentinel process 'TeX-command-sentinel)
3053           (set-marker (process-mark process) (point-max))
3054           (push process compilation-in-progress)
3055           (sit-for 0)
3056           process)
3057       (setq mode-line-process ": run")
3058       (set-buffer-modified-p (buffer-modified-p))
3059       (sit-for 0)                               ; redisplay
3060       (call-process TeX-shell nil (current-buffer) nil
3061                     TeX-shell-command-option
3062                     command))))
3063
3064 (defun preview-start-dvips (&optional fast)
3065   "Start a DviPS process.
3066 If FAST is set, do a fast conversion."
3067   (let* ((file preview-gs-file)
3068          tempdir
3069          (command (with-current-buffer TeX-command-buffer
3070                     (prog1
3071                         (TeX-command-expand (if fast
3072                                                 preview-fast-dvips-command
3073                                               preview-dvips-command)
3074                                             (car file))
3075                       (setq tempdir TeX-active-tempdir))))
3076          (name "Preview-DviPS"))
3077     (setq TeX-active-tempdir tempdir)
3078     (setq preview-ps-file (and fast
3079                                (preview-make-filename
3080                                 (preview-make-filename
3081                                  "preview.ps" tempdir) tempdir)))
3082     (goto-char (point-max))
3083     (insert-before-markers "Running `" name "' with ``" command "''\n")
3084     (setq mode-name name)
3085     (setq TeX-sentinel-function
3086           (lambda (process name) (message "%s: done." name)))
3087     (if TeX-process-asynchronous
3088         (let ((process (start-process name (current-buffer) TeX-shell
3089                                       TeX-shell-command-option
3090                                       command)))
3091           (if TeX-after-start-process-function
3092               (funcall TeX-after-start-process-function process))
3093           (TeX-command-mode-line process)
3094           (set-process-filter process 'TeX-command-filter)
3095           (set-process-sentinel process 'TeX-command-sentinel)
3096           (set-marker (process-mark process) (point-max))
3097           (push process compilation-in-progress)
3098           (sit-for 0)
3099           process)
3100       (setq mode-line-process ": run")
3101       (set-buffer-modified-p (buffer-modified-p))
3102       (sit-for 0)                               ; redisplay
3103       (call-process TeX-shell nil (current-buffer) nil
3104                     TeX-shell-command-option
3105                     command))))
3106
3107 (defun preview-start-pdf2dsc ()
3108   "Start a PDF2DSC process."
3109   (let* ((file preview-gs-file)
3110          tempdir
3111          pdfsource
3112          (command (with-current-buffer TeX-command-buffer
3113                     (prog1
3114                         (TeX-command-expand preview-pdf2dsc-command
3115                                             (car file))
3116                       (setq tempdir TeX-active-tempdir
3117                             pdfsource (funcall `,(car file) "pdf")))))
3118          (name "Preview-PDF2DSC"))
3119     (setq TeX-active-tempdir tempdir)
3120     (setq preview-ps-file (preview-attach-filename
3121                            pdfsource
3122                            (preview-make-filename
3123                             (preview-make-filename
3124                              "preview.dsc" tempdir) tempdir)))
3125     (goto-char (point-max))
3126     (insert-before-markers "Running `" name "' with ``" command "''\n")
3127     (setq mode-name name)
3128     (setq TeX-sentinel-function
3129           (lambda (process name) (message "%s: done." name)))
3130     (if TeX-process-asynchronous
3131         (let ((process (start-process name (current-buffer) TeX-shell
3132                                       TeX-shell-command-option
3133                                       command)))
3134           (if TeX-after-start-process-function
3135               (funcall TeX-after-start-process-function process))
3136           (TeX-command-mode-line process)
3137           (set-process-filter process 'TeX-command-filter)
3138           (set-process-sentinel process 'TeX-command-sentinel)
3139           (set-marker (process-mark process) (point-max))
3140           (push process compilation-in-progress)
3141           (sit-for 0)
3142           process)
3143       (setq mode-line-process ": run")
3144       (set-buffer-modified-p (buffer-modified-p))
3145       (sit-for 0)                               ; redisplay
3146       (call-process TeX-shell nil (current-buffer) nil
3147                     TeX-shell-command-option
3148                     command))))
3149
3150 (defun preview-TeX-inline-sentinel (process name)
3151   "Sentinel function for preview.
3152 See `TeX-sentinel-function' and `set-process-sentinel'
3153 for definition of PROCESS and NAME."
3154   (if process (TeX-format-mode-line process))
3155   (let ((status (process-status process)))
3156     (if (memq status '(signal exit))
3157         (delete-process process))
3158     (when (eq status 'exit)
3159       (save-excursion
3160         (goto-char (point-max))
3161         (forward-line -1)
3162         (if (search-forward "abnormally with code 1" nil t)
3163             (replace-match "as expected with code 1" t t)
3164           (if (search-forward "finished" nil t)
3165               (insert " with nothing to show"))))
3166       (condition-case err
3167           (preview-call-hook 'open)
3168         (error (preview-log-error err "LaTeX" process)))
3169       (preview-reraise-error process))))
3170
3171 (defcustom preview-format-extensions '(".fmt" ".efmt")
3172   "Possible extensions for format files.
3173 Those are just needed for cleanup."
3174   :group 'preview-latex
3175   :type '(repeat string))
3176
3177 (defun preview-format-kill (format-cons)
3178   "Kill a cached format.
3179 FORMAT-CONS is intended to be an element of `preview-dumped-alist'.
3180 Tries through `preview-format-extensions'."
3181   (dolist (ext preview-format-extensions)
3182     (condition-case nil
3183         (delete-file (preview-dump-file-name (concat (car format-cons) ext)))
3184       (file-error nil))))
3185
3186 (defun preview-dump-file-name (file)
3187   "Make a file name suitable for dumping from FILE."
3188   (if file
3189       (concat (file-name-directory file)
3190               "prv_"
3191               (progn
3192                 (setq file (file-name-nondirectory file))
3193                 (while (string-match " " file)
3194                   (setq file (replace-match "_" t t file)))
3195                 file))
3196     "prv_texput"))
3197
3198 (defun preview-do-replacements (string replacements)
3199   "Perform replacements in string.
3200 STRING is the input string, REPLACEMENTS is a list of replacements.
3201 A replacement is a cons-cell, where the car is the match string,
3202 and the cdr is a list of strings or symbols.  Symbols get dereferenced,
3203 and strings get evaluated as replacement strings."
3204   (let (rep case-fold-search)
3205     (while replacements
3206       (setq rep (pop replacements))
3207       (cond ((symbolp rep)
3208              (setq string (preview-do-replacements
3209                            string (symbol-value rep))))
3210             ((string-match (car rep) string)
3211              (setq string
3212                    (mapconcat (lambda(x)
3213                                 (if (symbolp x)
3214                                     (symbol-value x)
3215                                   (replace-match x t nil string)))
3216                               (cdr rep) ""))))))
3217   string)
3218
3219 (defconst preview-LaTeX-disable-pdfoutput
3220   '(("\\`\\(pdf[^ ]*\\)\
3221 \\(\\( [-&]\\([^ \"]\\|\"[^\"]*\"\\)*\\|\
3222  \"[-&][^\"]*\"\\)*\\)\\(.*\\)\\'"
3223    . ("\\1\\2 \"\\\\pdfoutput=0 \" \\5")))
3224   "This replacement places `\"\\pdfoutput=0 \"' after the options
3225 of any command starting with `pdf'.")
3226
3227 (defcustom preview-LaTeX-command-replacements
3228   nil
3229   "Replacement for `preview-LaTeX-command'.
3230 This is passed through `preview-do-replacements'."
3231   :group 'preview-latex
3232   :type '(repeat
3233           (choice
3234            (symbol :tag "Named replacement" :value preview-LaTeX-disable-pdfoutput)
3235            (cons (string :tag "Matched string")
3236                  (repeat :tag "Concatenated elements for replacement"
3237                          (choice (symbol :tag "Variable with literal string")
3238                                  (string :tag "non-literal regexp replacement")))))))
3239
3240 (defvar preview-format-name)
3241
3242 (defcustom preview-dump-replacements
3243   '(preview-LaTeX-command-replacements
3244     ("\\`\\([^ ]+\\)\
3245 \\(\\( +-\\([^ \\\\\"]\\|\\\\\\.\\|\"[^\"]*\"\\)*\\)*\\)\\(.*\\)\\'"
3246      . ("\\1 -ini -interaction=nonstopmode \"&\\1\" " preview-format-name ".ini \\5")))
3247   "Generate a dump command from the usual preview command."
3248   :group 'preview-latex
3249   :type '(repeat
3250           (choice (symbol :tag "Named replacement")
3251                   (cons string (repeat (choice symbol string))))))
3252
3253 (defcustom preview-undump-replacements
3254   '(("\\`\\([^ ]+\\)\
3255  .*? \"\\\\input\" \\(.*\\)\\'"
3256      . ("\\1 -interaction=nonstopmode \"&" preview-format-name "\" \\2")))
3257   "Use a dumped format for reading preamble."
3258   :group 'preview-latex
3259   :type '(repeat
3260           (choice (symbol :tag "Named replacement")
3261                   (cons string (repeat (choice symbol string))))))
3262
3263
3264 (defun preview-cache-preamble (&optional format-cons)
3265   "Dump a pregenerated format file.
3266 For the rest of the session, this file is used when running
3267 on the same master file.
3268
3269 Returns the process for dumping, nil if there is still a valid
3270 format available.
3271
3272 If FORMAT-CONS is non-nil, a previous format may get reused."
3273   (interactive)
3274   (let* ((dump-file
3275           (expand-file-name (preview-dump-file-name (TeX-master-file "ini"))))
3276          (master (TeX-master-file))
3277          (format-name (expand-file-name master))
3278          (preview-format-name (shell-quote-argument
3279                                (preview-dump-file-name (file-name-nondirectory
3280                                                         master))))
3281          (master-file (expand-file-name (TeX-master-file t)))
3282          (command (preview-do-replacements
3283                    (TeX-command-expand
3284                     (preview-string-expand preview-LaTeX-command)
3285                     'TeX-master-file)
3286                    preview-dump-replacements))
3287          (preview-auto-cache-preamble nil))
3288     (unless (and (consp (cdr format-cons))
3289                  (string= command (cadr format-cons)))
3290       (unless format-cons
3291         (setq format-cons (assoc format-name preview-dumped-alist)))
3292       (if format-cons
3293           (preview-cache-preamble-off format-cons)
3294         (setq format-cons (list format-name))
3295         (push format-cons preview-dumped-alist))
3296       ;; mylatex.ltx expects a file name to follow.  Bad. `.tex'
3297       ;; in the tools bundle is an empty file.
3298       (write-region "\\ifx\\pdfoutput\\undefined\\else\
3299 \\let\\PREVIEWdump\\dump\\def\\dump{%
3300 \\edef\\next{{\\catcode`\\ 9 \\pdfoutput=\\the\\pdfoutput\\relax\
3301 \\the\\everyjob}}\\everyjob\\next\\catcode`\\ 10 \\let\\dump\\PREVIEWdump\\dump}\\fi\\input mylatex.ltx \\relax\n" nil dump-file)
3302       (TeX-save-document master)
3303       (prog1
3304           (preview-generate-preview
3305            nil (file-name-nondirectory master)
3306            command)
3307         (add-hook 'kill-emacs-hook #'preview-cleanout-tempfiles t)
3308         (setq TeX-sentinel-function
3309               `(lambda (process string)
3310                  (condition-case err
3311                      (progn
3312                        (if (and (eq (process-status process) 'exit)
3313                                 (zerop (process-exit-status process)))
3314                            (preview-watch-preamble
3315                             ',master-file
3316                             ',command
3317                             ',format-cons)
3318                          (preview-format-kill ',format-cons))
3319                        (delete-file ',dump-file))
3320                    (error (preview-log-error err "Dumping" process)))
3321                  (preview-reraise-error process)))))))
3322
3323 (defun preview-cache-preamble-off (&optional old-format)
3324   "Clear the pregenerated format file.
3325 The use of the format file is discontinued.
3326 OLD-FORMAT may already contain a format-cons as
3327 stored in `preview-dumped-alist'."
3328   (interactive)
3329   (unless old-format
3330     (setq old-format
3331           (let ((master-file (expand-file-name (TeX-master-file))))
3332             (or (assoc master-file preview-dumped-alist)
3333                 (car (push (list master-file) preview-dumped-alist))))))
3334   (preview-unwatch-preamble old-format)
3335   (preview-format-kill old-format)
3336   (setcdr old-format nil))
3337
3338 (defun preview-region (begin end)
3339   "Run preview on region between BEGIN and END."
3340   (interactive "r")
3341   (TeX-region-create (TeX-region-file TeX-default-extension)
3342                      (buffer-substring begin end)
3343                      (if buffer-file-name
3344                          (file-name-nondirectory buffer-file-name)
3345                        "<none>")
3346                      (save-restriction
3347                        (widen)
3348                        (let ((inhibit-point-motion-hooks t)
3349                              (inhibit-field-text-motion t))
3350                          (+ (count-lines (point-min) begin)
3351                             (save-excursion
3352                               (goto-char begin)
3353                               (if (bolp) 0 -1))))))
3354   (preview-generate-preview t (TeX-region-file nil t)
3355                             (preview-do-replacements
3356                              (TeX-command-expand
3357                               (preview-string-expand preview-LaTeX-command)
3358                               'TeX-region-file)
3359                              preview-LaTeX-command-replacements)))
3360
3361 (defun preview-buffer ()
3362   "Run preview on current buffer."
3363   (interactive)
3364   (preview-region (point-min) (point-max)))
3365
3366 ;; We have a big problem: When we are dumping preambles, diagnostics
3367 ;; issued in later runs will not make it to the output when the
3368 ;; predumped format skips the preamble.  So we have to place those
3369 ;; after \begin{document}.  This we can only do if regions never
3370 ;; include the preamble.  We could do this in our own functions, but
3371 ;; that would not extend to the operation of C-c C-r g RET.  So we
3372 ;; make this preamble skipping business part of TeX-region-create.
3373 ;; This will fail if the region is to contain just part of the
3374 ;; preamble -- a bad idea anyhow.
3375
3376 (defadvice TeX-region-create (before preview-preamble preactivate activate)
3377   "Skip preamble for the sake of predumped formats."
3378   (when (string-match TeX-header-end (ad-get-arg 1))
3379     (ad-set-arg 1
3380                 (prog1 (substring (ad-get-arg 1) (match-end 0))
3381                   (ad-set-arg 3
3382                               (with-temp-buffer
3383                                 (insert (substring (ad-get-arg 1)
3384                                                    0 (match-end 0)))
3385                                 (+ (ad-get-arg 3)
3386                                    (count-lines (point-min) (point-max))
3387                                    (if (bolp) 0 -1))))))))
3388
3389 (defun preview-document ()
3390   "Run preview on master document."
3391   (interactive)
3392   (TeX-save-document (TeX-master-file))
3393   (preview-generate-preview
3394    nil (TeX-master-file nil t)
3395    (preview-do-replacements
3396     (TeX-command-expand
3397      (preview-string-expand preview-LaTeX-command)
3398      'TeX-master-file)
3399     preview-LaTeX-command-replacements)))
3400
3401 (defun preview-environment (count)
3402   "Run preview on LaTeX environment.
3403 This avoids running environments through preview that are
3404 indicated in `preview-inner-environments'.  If you use a prefix
3405 argument COUNT, the corresponding level of outward nested
3406 environments is selected."
3407   (interactive "p")
3408   (save-excursion
3409     (let (currenv)
3410       (dotimes (i (1- count))
3411         (setq currenv (LaTeX-current-environment))
3412         (if (string= currenv "document")
3413             (error "No enclosing outer environment found"))
3414         (LaTeX-find-matching-begin))
3415       (while (member (setq currenv (LaTeX-current-environment))
3416                      preview-inner-environments)
3417         (LaTeX-find-matching-begin))
3418       (if (string= currenv "document")
3419           (error "No enclosing outer environment found"))
3420       (preview-region
3421        (save-excursion (LaTeX-find-matching-begin) (point))
3422        (save-excursion (LaTeX-find-matching-end) (point))))))
3423
3424 (defun preview-section ()
3425   "Run preview on LaTeX section." (interactive)
3426   (save-excursion
3427     (LaTeX-mark-section)
3428     (preview-region (region-beginning) (region-end))))
3429
3430
3431 (defun preview-generate-preview (region-p file command)
3432   "Generate a preview.
3433 REGION-P is the region flag, FILE the file (without default
3434 extension and directory), COMMAND is the command to use.
3435
3436 It returns the started process."
3437   (setq TeX-current-process-region-p region-p)
3438   (let* ((geometry (preview-get-geometry))
3439          (commandbuff (current-buffer))
3440          (pr-file (cons
3441                    (if TeX-current-process-region-p
3442                        'TeX-region-file
3443                      'TeX-master-file)
3444                    file))
3445          (master (TeX-master-file))
3446          (master-file (expand-file-name master))
3447          (dumped-cons (assoc master-file
3448                              preview-dumped-alist))
3449          process)
3450     (unless dumped-cons
3451       (push (setq dumped-cons (cons master-file
3452                                     (if (eq preview-auto-cache-preamble 'ask)
3453                                         (y-or-n-p "Cache preamble? ")
3454                                       preview-auto-cache-preamble)))
3455             preview-dumped-alist))
3456     (when (cdr dumped-cons)
3457       (let* (TeX-current-process-region-p)
3458         (setq process (preview-cache-preamble dumped-cons))
3459         (if process
3460             (setq TeX-sentinel-function
3461                   `(lambda (process string)
3462                      (funcall ,TeX-sentinel-function process string)
3463                      (TeX-inline-preview-internal
3464                       ,command ,file
3465                       ',pr-file ,commandbuff
3466                       ',dumped-cons
3467                       ',master
3468                       ',geometry
3469                       (buffer-string)))))))
3470     (or process
3471         (TeX-inline-preview-internal command file
3472                                      pr-file commandbuff
3473                                      dumped-cons master
3474                                      geometry))))
3475
3476 (defun TeX-inline-preview-internal (command file pr-file
3477                                     commandbuff dumped-cons master
3478                                     geometry
3479                                     &optional str)
3480   "Internal stuff for previewing.
3481 COMMAND and FILE should be explained in `TeX-command-list'.
3482 PR-FILE is the target file name in the form for `preview-gs-file'.
3483 COMMANDBUFF, DUMPED-CONS, MASTER, and GEOMETRY are
3484 internal parameters, STR may be a log to insert into the current log."
3485   (set-buffer commandbuff)
3486   (let*
3487       ((preview-format-name (shell-quote-argument
3488                              (preview-dump-file-name
3489                               (file-name-nondirectory master))))
3490        (process
3491         (TeX-run-command
3492          "Preview-LaTeX"
3493          (if (consp (cdr dumped-cons))
3494              (preview-do-replacements
3495               command preview-undump-replacements)
3496            command) file)))
3497     (condition-case err
3498         (progn
3499           (when str
3500             (save-excursion
3501               (goto-char (point-min))
3502               (insert str)
3503               (when (= (process-mark process) (point-min))
3504                 (set-marker (process-mark process) (point)))))
3505           (preview-set-geometry geometry)
3506           (setq preview-gs-file pr-file)
3507           (setq TeX-sentinel-function 'preview-TeX-inline-sentinel)
3508           (when (featurep 'mule)
3509             (setq preview-coding-system
3510                   (or (and (boundp 'TeX-japanese-process-output-coding-system)
3511                            TeX-japanese-process-output-coding-system)
3512                       (with-current-buffer commandbuff
3513                         buffer-file-coding-system)))
3514             (when preview-coding-system
3515               (setq preview-coding-system
3516                     (preview-buffer-recode-system
3517                      (coding-system-base preview-coding-system))))
3518             (set-process-coding-system
3519              process preview-coding-system))
3520           (TeX-parse-reset)
3521           (setq TeX-parse-function 'TeX-parse-TeX)
3522           (if TeX-process-asynchronous
3523               process
3524             (TeX-synchronous-sentinel "Preview-LaTeX" file process)))
3525       (error (preview-log-error err "Preview" process)
3526              (delete-process process)
3527              (preview-reraise-error process)))))
3528
3529 (defconst preview-version "11.88"
3530   "Preview version.
3531 If not a regular release, the date of the last change.")
3532
3533 (defconst preview-release-date "2014-10-29"
3534   "Preview release date using the ISO 8601 format, yyyy-mm-dd.")
3535
3536 (defun preview-dump-state (buffer)
3537   (condition-case nil
3538       (progn
3539         (unless (local-variable-p 'TeX-command-buffer (current-buffer))
3540           (setq buffer (with-current-buffer buffer (TeX-active-buffer))))
3541         (when (bufferp buffer)
3542           (insert "\nRun buffer contents:\n\n")
3543           (if (< (buffer-size buffer) 5000)
3544               (insert-buffer-substring buffer)
3545             (insert-buffer-substring buffer 1 2500)
3546             (insert "...\n\n[...]\n\n\t...")
3547             (insert-buffer-substring buffer
3548                                      (- (buffer-size buffer) 2500)
3549                                      (buffer-size buffer)))
3550           (insert "\n")))
3551     (error nil)))
3552
3553 ;;;###autoload
3554 (defun preview-report-bug () "Report a bug in the preview-latex package."
3555   (interactive)
3556   (let ((reporter-prompt-for-summary-p "Bug report subject: "))
3557     (reporter-submit-bug-report
3558      "bug-auctex@gnu.org"
3559      preview-version
3560      '(AUCTeX-version
3561        LaTeX-command-style
3562        image-types
3563        preview-image-type
3564        preview-image-creators
3565        preview-dvipng-image-type
3566        preview-dvipng-command
3567        preview-pdf2dsc-command
3568        preview-gs-command
3569        preview-gs-options
3570        preview-gs-image-type-alist
3571        preview-fast-conversion
3572        preview-prefer-TeX-bb
3573        preview-dvips-command
3574        preview-fast-dvips-command
3575        preview-scale-function
3576        preview-LaTeX-command
3577        preview-required-option-list
3578        preview-preserve-counters
3579        preview-default-option-list
3580        preview-default-preamble
3581        preview-LaTeX-command-replacements
3582        preview-dump-replacements
3583        preview-undump-replacements
3584        preview-auto-cache-preamble
3585        preview-TeX-style-dir)
3586      `(lambda () (preview-dump-state ,(current-buffer)))
3587      (lambda ()
3588        (insert (format "\nOutput from running `%s -h':\n"
3589                        preview-gs-command))
3590        (call-process preview-gs-command nil t nil "-h")
3591        (insert "\n"))
3592      "Remember to cover the basics.  Including a minimal LaTeX example
3593 file exhibiting the problem might help."
3594      )))
3595
3596 (eval-when-compile
3597   (when (boundp 'preview-compatibility-macros)
3598     (dolist (elt preview-compatibility-macros)
3599       (if (consp elt)
3600           (fset (car elt) (cdr elt))
3601         (fmakunbound elt)))))
3602
3603 (makunbound 'preview-compatibility-macros)
3604
3605 (provide 'preview)
3606 ;;; preview.el ends here