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