]> code.delx.au - gnu-emacs-elpa/blob - packages/auctex/preview.el
Update AUCTeX ELPA package to the new 11.87 release.
[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, 2006, 2010 Free
4 ;; 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.286 2011/01/23 18:53:55 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" "-dDELAYSAFER" "-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 (all-files (if (and (consp (car preview-ps-file))
1075 (consp (caar preview-ps-file)))
1076 (caar preview-ps-file)
1077 (list file))))
1078 (setq preview-gs-dsc (preview-dsc-parse file))
1079 (setq preview-gs-init-string
1080 (concat (format "{<</PermitFileReading[%s]>> setuserparams \
1081 .locksafe} stopped pop "
1082 (mapconcat 'preview-ps-quote-filename all-files ""))
1083 preview-gs-init-string
1084 (format "[%s(r)file]aload exch %s .runandhide aload pop "
1085 (preview-ps-quote-filename file)
1086 (preview-gs-dsc-cvx 0 preview-gs-dsc))))))
1087
1088 (defun preview-gs-urgentize (ov buff)
1089 "Make a displayed overlay render with higher priority.
1090 This function is used in fake conditional display properties
1091 for reordering the conversion order to prioritize on-screen
1092 images. OV is the overlay in question, and BUFF is the
1093 Ghostscript process buffer where the buffer-local queue
1094 is located."
1095 ;; It does not matter that ov gets queued twice in that process: the
1096 ;; first version to get rendered will clear the 'queued property.
1097 ;; It cannot get queued more than twice since we remove the
1098 ;; conditional display property responsible for requeuing here.
1099 ;; We don't requeue if the overlay has been killed (its buffer made
1100 ;; nil). Not necessary, but while we are checking...
1101 ;; We must return t.
1102 (preview-remove-urgentization ov)
1103 (when (and (overlay-get ov 'queued)
1104 (overlay-buffer ov))
1105 (with-current-buffer buff
1106 (push ov preview-gs-queue)))
1107 t)
1108
1109
1110 (defun preview-gs-place (ov snippet box run-buffer tempdir ps-file imagetype)
1111 "Generate an image placeholder rendered over by Ghostscript.
1112 This enters OV into all proper queues in order to make it render
1113 this image for real later, and returns the overlay after setting
1114 a placeholder image. SNIPPET gives the number of the
1115 snippet in question for the file to be generated.
1116 BOX is a bounding box if we already know one via TeX.
1117 RUN-BUFFER is the buffer of the TeX process,
1118 TEMPDIR is the correct copy of `TeX-active-tempdir',
1119 PS-FILE is a copy of `preview-ps-file', IMAGETYPE is the image type
1120 for the file extension."
1121 (overlay-put ov 'filenames
1122 (unless (eq ps-file t)
1123 (list
1124 (preview-make-filename
1125 (or ps-file
1126 (format "preview.%03d" snippet))
1127 tempdir))))
1128 (overlay-put ov 'queued
1129 (vector box nil snippet))
1130 (overlay-put ov 'preview-image
1131 (list (preview-icon-copy preview-nonready-icon)))
1132 (preview-add-urgentization #'preview-gs-urgentize ov run-buffer)
1133 (list ov))
1134
1135 (defun preview-mouse-open-error (string)
1136 "Display STRING in a new view buffer on click."
1137 (let ((buff (get-buffer-create
1138 "*Preview-Ghostscript-Error*")))
1139 (with-current-buffer buff
1140 (kill-all-local-variables)
1141 (set (make-local-variable 'view-exit-action) #'kill-buffer)
1142 (setq buffer-undo-list t)
1143 (erase-buffer)
1144 (insert string)
1145 (goto-char (point-min)))
1146 (view-buffer-other-window buff)))
1147
1148 (defun preview-mouse-open-eps (file &optional position)
1149 "Display eps FILE in a view buffer on click.
1150 Place point at POSITION, else beginning of file."
1151 (let ((default-major-mode
1152 (or
1153 (assoc-default "x.ps" auto-mode-alist #'string-match)
1154 default-major-mode))
1155 (buff (get-file-buffer file)))
1156 (save-excursion
1157 (if buff
1158 (pop-to-buffer buff)
1159 (view-file-other-window file))
1160 (goto-char (or position (point-min)))
1161 (if (eq major-mode 'ps-mode) ; Bundled with GNU Emacs
1162 (message "%s" (substitute-command-keys "\
1163 Try \\[ps-run-start] \\[ps-run-buffer] and \
1164 \\<ps-run-mode-map>\\[ps-run-mouse-goto-error] on error offset." )))
1165 (if (eq major-mode 'postscript-mode) ; Bundled with XEmacs, limited
1166 (message "%s" (substitute-command-keys "\
1167 Try \\[ps-shell] and \\[ps-execute-buffer]."))))))
1168
1169 (defun preview-gs-flag-error (ov err)
1170 "Make an eps error flag in overlay OV for ERR string."
1171 (let* ((filenames (overlay-get ov 'filenames))
1172 (file (car (nth 0 filenames)))
1173 (outfile (format "-dOutputFile=%s"
1174 (preview-ps-quote-filename
1175 (car (nth 1 filenames)))))
1176 (ps-open
1177 `(lambda() (interactive "@")
1178 (preview-mouse-open-error
1179 ,(concat
1180 (mapconcat #'shell-quote-argument
1181 (append (list
1182 preview-gs-command
1183 outfile)
1184 preview-gs-command-line)
1185 " ")
1186 "\nGS>"
1187 preview-gs-init-string
1188 (aref (overlay-get ov 'queued) 1)
1189 err))))
1190 (str
1191 (preview-make-clickable
1192 nil
1193 preview-error-icon
1194 "%s views error message
1195 %s more options"
1196 ps-open
1197 `(lambda() (interactive)
1198 (popup-menu
1199 '("PostScript error"
1200 ["View error" ,ps-open]
1201 ["View source"
1202 (lambda () (interactive "@")
1203 ,(if preview-ps-file
1204 `(preview-mouse-open-eps
1205 ,(if (consp (car file))
1206 (nth 1 (car file))
1207 (car file))
1208 ,(nth 0 (aref preview-gs-dsc
1209 (aref (overlay-get ov 'queued) 2))))
1210 `(preview-mouse-open-eps ,file)))]))))))
1211 (overlay-put ov 'strings (cons str str))
1212 (preview-toggle ov)))
1213
1214 (defun preview-gs-transact (process answer)
1215 "Work off Ghostscript transaction.
1216 This routine is the action routine called via the process filter.
1217 The Ghostscript process buffer of PROCESS will already be selected, and
1218 and the standard output of Ghostscript up to the next prompt will be
1219 given as ANSWER."
1220 (let ((ov (pop preview-gs-outstanding))
1221 (have-error (not
1222 (string-match "\\`GS\\(<[0-9]+\\)?>\\'" answer ))))
1223 (when (and ov (overlay-buffer ov))
1224 (let ((queued (overlay-get ov 'queued)))
1225 (when queued
1226 (let* ((bbox (aref queued 0))
1227 (filenames (overlay-get ov 'filenames))
1228 (oldfile (nth 0 filenames))
1229 (newfile (nth 1 filenames)))
1230 (if have-error
1231 (preview-gs-flag-error ov answer)
1232 (condition-case nil
1233 (preview-delete-file oldfile)
1234 (file-error nil))
1235 (overlay-put ov 'filenames (cdr filenames))
1236 (preview-replace-active-icon
1237 ov
1238 (preview-create-icon (car newfile)
1239 preview-gs-image-type
1240 (preview-ascent-from-bb
1241 bbox)
1242 (aref preview-colors 2))))
1243 (overlay-put ov 'queued nil)))))
1244 (while (and (< (length preview-gs-outstanding)
1245 preview-gs-outstanding-limit)
1246 (setq ov (pop preview-gs-queue)))
1247 (let ((queued (overlay-get ov 'queued)))
1248 (when (and queued
1249 (not (memq ov preview-gs-outstanding))
1250 (overlay-buffer ov))
1251 (let* ((filenames (overlay-get ov 'filenames))
1252 (oldfile (car (nth 0
1253 (nconc filenames
1254 (list
1255 (preview-make-filename
1256 (format "pr%d-%d.%s"
1257 (car preview-gs-sequence)
1258 (cdr preview-gs-sequence)
1259 preview-gs-image-type)
1260 TeX-active-tempdir))))))
1261 (bbox (aset queued 0
1262 (or (and preview-prefer-TeX-bb
1263 (aref queued 0))
1264 (and (stringp oldfile)
1265 (preview-extract-bb
1266 oldfile))
1267 (aref queued 0)
1268 (error "No bounding box"))))
1269 (snippet (aref queued 2))
1270 (gs-line
1271 (format
1272 "%s<<%s>>preview-do\n"
1273 (if preview-ps-file
1274 (concat "dup "
1275 (preview-gs-dsc-cvx
1276 snippet
1277 preview-gs-dsc))
1278 (format "%s(r)file cvx"
1279 (preview-ps-quote-filename
1280 (if (listp oldfile)
1281 (car (last oldfile))
1282 oldfile))))
1283 (if preview-parsed-tightpage
1284 ""
1285 (format "/PageSize[%g %g]/PageOffset[%g \
1286 %g[1 1 dtransform exch]{0 ge{neg}if exch}forall]"
1287 (- (aref bbox 2) (aref bbox 0))
1288 (- (aref bbox 3) (aref bbox 1))
1289 (aref bbox 0) (aref bbox 1))))))
1290 (setcdr preview-gs-sequence (1+ (cdr preview-gs-sequence)))
1291 (setq preview-gs-outstanding
1292 (nconc preview-gs-outstanding
1293 (list ov)))
1294 (aset queued 1 gs-line)
1295 ;; ignore errors because of dying processes: they will get
1296 ;; caught by the sentinel, anyway.
1297 (condition-case nil
1298 (process-send-string
1299 process
1300 gs-line)
1301 (error nil))))))
1302 (unless preview-gs-outstanding
1303 (condition-case nil
1304 (process-send-eof process)
1305 (error nil)))))
1306
1307 (defun preview-hook-enquiry (hook)
1308 "Gets a value from a configured hook.
1309 HOOK is a list or single item, for which the first resolving to
1310 non-nil counts. Entries can be a callable function, or
1311 a symbol that is consulted, or a value. Lists are evaluated
1312 recursively."
1313 (cond ((functionp hook)
1314 (funcall hook))
1315 ((consp hook)
1316 (let (res)
1317 (while (and (not res) hook)
1318 (setq res (preview-hook-enquiry (car hook))
1319 hook (cdr hook)))
1320 res))
1321 ((and (symbolp hook) (boundp hook))
1322 (symbol-value hook))
1323 (t hook)))
1324
1325 (defcustom preview-scale-function #'preview-scale-from-face
1326 "*Scale factor for included previews.
1327 This can be either a function to calculate the scale, or
1328 a fixed number."
1329 :group 'preview-appearance
1330 :type '(choice (function-item preview-scale-from-face)
1331 (const 1.0)
1332 (number :value 1.0)
1333 (function :value preview-scale-from-face)))
1334
1335 (defcustom preview-default-document-pt 10
1336 "*Assumed document point size for `preview-scale-from-face'.
1337 If the point size (such as 11pt) of the document cannot be
1338 determined from the document options itself, assume this size.
1339 This is for matching screen font size and previews."
1340 :group 'preview-appearance
1341 :type
1342 '(choice (const :tag "10pt" 10)
1343 (const :tag "11pt" 11)
1344 (const :tag "12pt" 12)
1345 (number :tag "Other" :value 11.0))
1346 )
1347
1348 (defcustom preview-document-pt-list '(preview-parsed-font-size
1349 preview-auctex-font-size
1350 preview-default-document-pt)
1351 "*How `preview-document-pt' figures out the document size."
1352 :group 'preview-appearance
1353 :type
1354 '(repeat (choice
1355 ;; This is a bug: type function seems to match variables, too.
1356 (restricted-sexp :match-alternatives (functionp)
1357 :tag "Function" :value preview-auctex-font-size)
1358 (variable :value preview-parsed-font-size)
1359 (number :value 11))))
1360
1361 (defun preview-auctex-font-size ()
1362 "Calculate the default font size of document.
1363 If packages, classes or styles were called with an option
1364 like 10pt, size is taken from the first such option if you
1365 had let your document be parsed by AucTeX."
1366 (catch 'return (dolist (option (TeX-style-list))
1367 (if (string-match "\\`\\([0-9]+\\)pt\\'" option)
1368 (throw 'return
1369 (string-to-number
1370 (match-string 1 option)))))))
1371
1372 (defsubst preview-document-pt ()
1373 "Calculate the default font size of document."
1374 (preview-hook-enquiry preview-document-pt-list))
1375
1376 (defun preview-scale-from-face ()
1377 "Calculate preview scale from `preview-reference-face'.
1378 This calculates the scale of EPS images from a document assumed
1379 to have a default font size given by function `preview-document-pt'
1380 so that they match the reference face in height."
1381 `(lambda nil
1382 (/ ,(/ (preview-inherited-face-attribute 'preview-reference-face :height
1383 'default) 10.0)
1384 (preview-document-pt))))
1385
1386 (defvar preview-min-spec)
1387
1388 (defun preview-make-image (symbol)
1389 "Make an image from a preview spec list.
1390 The first spec that is workable (given the current setting of
1391 `preview-min-spec') from the given symbol is used here. The
1392 icon is cached in the property list of the symbol."
1393 (let ((alist (get 'preview-min-alist symbol)))
1394 (cdr (or
1395 (assq preview-min-spec alist)
1396 (car (put symbol 'preview-min-alist
1397 (cons
1398 (cons preview-min-spec
1399 (preview-filter-specs
1400 (symbol-value symbol)))
1401 alist)))))))
1402
1403 (defun preview-filter-specs (spec-list)
1404 "Find the first of the fitting specs and make an image."
1405 (let (image)
1406 (while (and spec-list
1407 (not (setq image
1408 (catch 'preview-filter-specs
1409 (preview-filter-specs-1 (car spec-list))))))
1410 (setq spec-list (cdr spec-list)))
1411 image))
1412
1413 (defun preview-filter-specs-1 (specs)
1414 (and specs
1415 (if (get 'preview-filter-specs (car specs))
1416 (apply (get 'preview-filter-specs (car specs)) specs)
1417 `(,(nth 0 specs) ,(nth 1 specs)
1418 ,@(preview-filter-specs-1 (nthcdr 2 specs))))))
1419
1420 (put 'preview-filter-specs :min
1421 #'(lambda (keyword value &rest args)
1422 (if (> value preview-min-spec)
1423 (throw 'preview-filter-specs nil)
1424 (preview-filter-specs-1 args))))
1425
1426 (defvar preview-datadir (file-name-directory load-file-name)
1427 "The directory relative to which package data may be found.
1428 This should be hardwired into the startup file containing the
1429 autoloads for preview-latex.")
1430
1431 (put 'preview-filter-specs :file
1432 #'(lambda (keyword value &rest args)
1433 `(:file ,(expand-file-name value (expand-file-name "images"
1434 preview-datadir))
1435 ,@(preview-filter-specs-1 args))))
1436
1437 (defun preview-ascent-from-bb (bb)
1438 "This calculates the image ascent from its bounding box.
1439 The bounding box BB needs to be a 4-component vector of
1440 numbers (can be float if available)."
1441 ;; baseline is at 1in from the top of letter paper (11in), so it is
1442 ;; at 10in from the bottom precisely, which is 720 in PostScript
1443 ;; coordinates. If our bounding box has its bottom not above this
1444 ;; line, and its top above, we can calculate a useful ascent value.
1445 ;; If not, something is amiss. We just use 100 in that case.
1446
1447 (let ((bottom (aref bb 1))
1448 (top (aref bb 3)))
1449 (if (and (<= bottom 720)
1450 (> top 720))
1451 (round (* 100.0 (/ (- top 720.0) (- top bottom))))
1452 100)))
1453
1454 (defface preview-face '((((background dark))
1455 (:background "dark slate gray"))
1456 (t
1457 (:background "beige")))
1458 "Face to use for the preview source."
1459 :group 'preview-appearance)
1460
1461 (defface preview-reference-face '((t nil))
1462 "Face consulted for colors and scale of active previews.
1463 Fallback to :inherit and 'default implemented."
1464 :group 'preview-appearance)
1465
1466 (defcustom preview-auto-reveal
1467 '(eval (preview-arrived-via (key-binding [left]) (key-binding [right])
1468 'backward-char 'forward-char))
1469 "*Cause previews to open automatically when entered.
1470 Possibilities are:
1471 T autoopens,
1472 NIL doesn't,
1473 a symbol will have its value consulted if it exists,
1474 defaulting to NIL if it doesn't.
1475 An integer will specify a maximum cursor movement distance.
1476 Larger movements won't open the preview.
1477 A CONS-cell means to call a function for determining the value.
1478 The CAR of the cell is the function to call which receives
1479 the CDR of the CONS-cell in the rest of the arguments, while
1480 point and current buffer point to the position in question.
1481 All of the options show reasonable defaults."
1482 :group 'preview-appearance
1483 :type '(choice (const :tag "Off" nil)
1484 (const :tag "On" t)
1485 (symbol :tag "Indirect variable" :value reveal-mode)
1486 (integer :tag "Maximum distance" :value 1)
1487 (cons :tag "Function call"
1488 :value (eval (preview-arrived-via
1489 (key-binding [left])
1490 (key-binding [right])))
1491 function (list :tag "Argument list"
1492 (repeat :inline t sexp)))))
1493
1494 (defun preview-auto-reveal-p (mode distance)
1495 "Decide whether to auto-reveal.
1496 Returns non-NIL if region should be auto-opened.
1497 See `preview-auto-reveal' for definitions of MODE, which gets
1498 set to `preview-auto-reveal'. DISTANCE specifies the movement
1499 distance with which point has been reached in case it has been
1500 a movement starting in the current buffer."
1501 (cond ((symbolp mode)
1502 (and (boundp mode)
1503 (symbol-value mode)))
1504 ((integerp mode)
1505 (and distance (/= 0 distance) (<= (abs distance) mode)))
1506 ((consp mode)
1507 (apply (car mode) (cdr mode)))
1508 (t mode)))
1509
1510 (defun preview-arrived-via (&rest list)
1511 "Indicate auto-opening.
1512 Returns non-NIL if called by one of the commands in LIST."
1513 (memq this-command list))
1514
1515 (defcustom preview-equality-transforms '(identity
1516 preview-canonical-spaces)
1517 "Transformation functions for region changes.
1518 These functions are tried in turn on the strings from the
1519 regions of a preview to decide whether a preview is to be considered
1520 changed. If any transform leads to equal results, the preview is
1521 considered unchanged."
1522 :group 'preview-appearance
1523 :type '(repeat function))
1524
1525 (defun preview-relaxed-string= (&rest args)
1526 "Check for functional equality of arguments.
1527 The arguments ARGS are checked for equality by using
1528 `preview-equality-transforms' on them until it is exhausted
1529 or one transform returns equality."
1530 (let ((lst preview-equality-transforms))
1531 (while (and lst (not (apply #'string= (mapcar (car lst) args))))
1532 (setq lst (cdr lst)))
1533 lst))
1534
1535 (defun preview-canonical-spaces (arg)
1536 "Convert ARG into canonical form.
1537 Removes comments and collapses white space, except for multiple newlines."
1538 (let (pos)
1539 (while (setq pos (string-match "\\s<.*[\n\r][ \t]*" arg pos))
1540 (setq arg (replace-match "" t t arg 0)))
1541 (while (setq pos (string-match "[ \t]*\\(\\([ \t]\\)\\|[\n\r][ \t]*\\)"
1542 arg pos))
1543 (setq arg (replace-match (if (match-beginning 2) " " "\n") t t arg 0)
1544 pos (1+ pos)))
1545 (while (setq pos (string-match "\n+" arg pos))
1546 (if (string= "\n" (match-string 0 arg))
1547 (setq arg (replace-match " " t t arg 0)
1548 pos (1+ pos))
1549 (setq pos (match-end 0)))))
1550 arg)
1551
1552 (defun preview-regenerate (ovr)
1553 "Pass the modified region in OVR again through LaTeX."
1554 (let ((begin (overlay-start ovr))
1555 (end (overlay-end ovr)))
1556 (with-current-buffer (overlay-buffer ovr)
1557 (preview-delete ovr)
1558 (preview-region begin end))))
1559
1560 (defcustom preview-inner-environments '("Bmatrix" "Vmatrix" "aligned"
1561 "array" "bmatrix" "cases"
1562 "gathered" "matrix" "pmatrix"
1563 "smallmatrix" "split"
1564 "subarray" "vmatrix")
1565 "Environments not to be previewed on their own."
1566 :group 'preview-latex
1567 :type '(repeat string))
1568
1569
1570 (defun preview-next-border (backwards)
1571 "Search for the next interesting border for `preview-at-point'.
1572 Searches backwards if BACKWARDS is non-nil."
1573 (let (history preview-state (pt (point)))
1574 (catch 'exit
1575 (while
1576 (null
1577 (memq
1578 (setq preview-state
1579 (if backwards
1580 (if (> (setq pt
1581 (previous-single-char-property-change
1582 pt 'preview-state)) (point-min))
1583 (get-char-property (1- pt) 'preview-state)
1584 (throw 'exit (or history (point-min))))
1585 (if (< (setq pt
1586 (next-single-char-property-change
1587 pt 'preview-state)) (point-max))
1588 (get-char-property pt 'preview-state)
1589 (throw 'exit (or history (point-max))))))
1590 '(active inactive)))
1591 (setq history (and (not preview-state) pt)))
1592 (or history pt))))
1593
1594 (defun preview-at-point ()
1595 "Do the appropriate preview thing at point.
1596 If point is positioned on or inside of an unmodified preview area,
1597 its visibility is toggled.
1598
1599 If not, the surroundings are run through preview. The
1600 surroundings don't extend into unmodified previews or past
1601 contiguous previews invalidated by modifications.
1602
1603 Overriding any other action, if a region is
1604 active (`transient-mark-mode' or `zmacs-regions'), it is run
1605 through `preview-region'."
1606 (interactive)
1607 (if (TeX-active-mark)
1608 (preview-region (region-beginning) (region-end))
1609 (catch 'exit
1610 (dolist (ovr (overlays-in (max (point-min) (1- (point)))
1611 (min (point-max) (1+ (point)))))
1612 (let ((preview-state (overlay-get ovr 'preview-state)))
1613 (when preview-state
1614 (unless (eq preview-state 'disabled)
1615 (preview-toggle ovr 'toggle (selected-window))
1616 (throw 'exit t)))))
1617 (preview-region (preview-next-border t)
1618 (preview-next-border nil)))))
1619
1620 (defun preview-disabled-string (ov)
1621 "Generate a before-string for disabled preview overlay OV."
1622 (concat (preview-make-clickable
1623 (overlay-get ov 'preview-map)
1624 preview-icon
1625 "\
1626 %s regenerates preview
1627 %s more options"
1628 `(lambda() (interactive) (preview-regenerate ,ov)))
1629 ;; icon on separate line only for stuff starting on its own line
1630 (with-current-buffer (overlay-buffer ov)
1631 (save-excursion
1632 (save-restriction
1633 (widen)
1634 (goto-char (overlay-start ov))
1635 (if (bolp) "\n" ""))))))
1636
1637 (defun preview-disable (ovr)
1638 "Change overlay behaviour of OVR after source edits."
1639 (overlay-put ovr 'queued nil)
1640 (preview-remove-urgentization ovr)
1641 (overlay-put ovr 'preview-image nil)
1642 (overlay-put ovr 'timestamp nil)
1643 (setcdr (overlay-get ovr 'strings) (preview-disabled-string ovr))
1644 (preview-toggle ovr)
1645 (overlay-put ovr 'preview-state 'disabled)
1646 (dolist (filename (overlay-get ovr 'filenames))
1647 (condition-case nil
1648 (preview-delete-file filename)
1649 (file-error nil))
1650 (overlay-put ovr 'filenames nil)))
1651
1652 (defun preview-delete (ovr &rest ignored)
1653 "Delete preview overlay OVR, taking any associated file along.
1654 IGNORED arguments are ignored, making this function usable as
1655 a hook in some cases"
1656 (let ((filenames (overlay-get ovr 'filenames)))
1657 (overlay-put ovr 'filenames nil)
1658 (delete-overlay ovr)
1659 (dolist (filename filenames)
1660 (condition-case nil
1661 (preview-delete-file filename)
1662 (file-error nil)))))
1663
1664 (defun preview-clearout (&optional start end timestamp)
1665 "Clear out all previews in the current region.
1666 When called interactively, the current region is used.
1667 Non-interactively, the region between START and END is
1668 affected. Those two values default to the borders of
1669 the entire buffer. If TIMESTAMP is non-nil, previews
1670 with a `timestamp' property of it are kept."
1671 (interactive "r")
1672 (dolist (ov (overlays-in (or start (point-min))
1673 (or end (point-max))))
1674 (and (overlay-get ov 'preview-state)
1675 (not (and timestamp
1676 (equal timestamp (overlay-get ov 'timestamp))))
1677 (preview-delete ov))))
1678
1679 (defun preview-clearout-buffer (&optional buffer)
1680 "Clearout BUFFER from previews, current buffer if nil."
1681 (interactive)
1682 (if buffer
1683 (with-current-buffer buffer (preview-clearout))
1684 (preview-clearout)))
1685
1686 (defun preview-clearout-section ()
1687 "Clearout previews from LaTeX section."
1688 (interactive)
1689 (save-excursion
1690 (LaTeX-mark-section)
1691 (preview-clearout (region-beginning) (region-end))))
1692
1693 (defun preview-clearout-at-point ()
1694 "Clearout any preview at point."
1695 (interactive)
1696 (preview-clearout (max (point-min) (1- (point)))
1697 (min (point-max) (1+ (point)))))
1698
1699 (defun preview-walk-document (func)
1700 "Cycle through all buffers belonging to current document.
1701 Each buffer having the same master file as the current file
1702 has FUNC called with its current buffer being set to it."
1703 (let* ((buffers (buffer-list))
1704 (master (expand-file-name (TeX-master-file t)))
1705 (default-buffers (list (current-buffer)
1706 (find-buffer-visiting master))))
1707 (while buffers
1708 (with-current-buffer (pop buffers)
1709 (when
1710 (or (memq (current-buffer) default-buffers)
1711 (and (memq major-mode '(plain-tex-mode latex-mode))
1712 (or (stringp TeX-master)
1713 (eq TeX-master t))
1714 (string= (expand-file-name (TeX-master-file t))
1715 master)))
1716 (funcall func))))))
1717
1718 (defun preview-clearout-document ()
1719 "Clear out all previews in current document.
1720 The document consists of all buffers that have the same master file
1721 as the current buffer. This makes the current document lose
1722 all previews."
1723 (interactive)
1724 (preview-walk-document #'preview-clearout-buffer))
1725
1726 (defun preview-kill-buffer-cleanup (&optional buf)
1727 "This is a cleanup function just for use in hooks.
1728 Cleans BUF or current buffer. The difference to
1729 `preview-clearout-buffer' is that previews
1730 associated with the last buffer modification time are
1731 kept."
1732 (with-current-buffer (or buf (current-buffer))
1733 (save-restriction
1734 (widen)
1735 (preview-clearout (point-min) (point-max) (visited-file-modtime)))))
1736
1737 (add-hook 'kill-buffer-hook #'preview-kill-buffer-cleanup)
1738 (add-hook 'before-revert-hook #'preview-kill-buffer-cleanup)
1739
1740 (defvar preview-last-counter)
1741
1742 (defun preview-extract-counters (ctr)
1743 (setq preview-last-counter
1744 (prog1 (copy-sequence ctr)
1745 (dolist (elt preview-last-counter)
1746 (setq ctr (delete elt ctr)))))
1747 (apply #'concat ctr))
1748
1749 (defun desktop-buffer-preview-misc-data (&rest ignored)
1750 "Hook function that extracts previews for persistent sessions."
1751 (unless (buffer-modified-p)
1752 (setq preview-last-counter nil)
1753 (save-restriction
1754 (widen)
1755 (let (save-info (timestamp (visited-file-modtime)))
1756 (dolist (ov (sort (overlays-in (point-min) (point-max))
1757 (lambda (x y) (< (overlay-start x)
1758 (overlay-start y)))))
1759 (when (and (memq (overlay-get ov 'preview-state) '(active inactive))
1760 (null (overlay-get ov 'queued))
1761 (cdr (overlay-get ov 'preview-image)))
1762 (push (preview-dissect ov timestamp) save-info)))
1763 (and save-info
1764 (cons 'preview (cons timestamp (nreverse save-info))))))))
1765
1766 (eval-after-load "desktop"
1767 '(add-hook
1768 'desktop-buffer-misc-functions
1769 #'desktop-buffer-preview-misc-data))
1770
1771 (defvar preview-temp-dirs nil
1772 "List of top level temporary directories in use from preview.
1773 Any directory not in this list will be cleared out by preview
1774 on first use.")
1775
1776 (defun preview-dissect (ov timestamp)
1777 "Extract all persistent data from OV and TIMESTAMP it."
1778 (let ((filenames (butlast (nth 0 (overlay-get ov 'filenames)))))
1779 (overlay-put ov 'timestamp timestamp)
1780 (list (overlay-start ov)
1781 (overlay-end ov)
1782 (cdr (overlay-get ov 'preview-image))
1783 filenames
1784 (let ((ctr (overlay-get ov 'preview-counters)))
1785 (and ctr
1786 (cons (preview-extract-counters (car ctr))
1787 (preview-extract-counters (cdr ctr))))))))
1788
1789 (defun preview-buffer-restore-internal (buffer-misc)
1790 "Restore previews from BUFFER-MISC if proper.
1791 Remove them if they have expired."
1792 (let ((timestamp (visited-file-modtime)) tempdirlist files)
1793 (setq preview-parsed-counters nil)
1794 (when (eq 'preview (pop buffer-misc))
1795 (preview-get-geometry)
1796 (if (equal (pop buffer-misc) timestamp)
1797 (dolist (ovdata buffer-misc)
1798 (setq tempdirlist
1799 (apply #'preview-reinstate-preview tempdirlist
1800 timestamp ovdata)))
1801 (dolist (ovdata buffer-misc)
1802 (setq files (nth 3 ovdata))
1803 (condition-case nil
1804 (delete-file (nth 0 files))
1805 (file-error nil))
1806 (unless (member (nth 1 files) tempdirlist)
1807 (push (nth 1 files) tempdirlist)))
1808 (dolist (dir tempdirlist)
1809 (condition-case nil
1810 (delete-directory dir)
1811 (file-error nil)))))))
1812
1813
1814 (defun preview-buffer-restore (buffer-misc)
1815 "At end of desktop load, reinstate previews.
1816 This delay is so that minor modes changing buffer positions
1817 \(like `x-symbol-mode' does) will not wreak havoc.
1818 BUFFER-MISC is the appropriate data to be used."
1819 (add-hook 'desktop-delay-hook `(lambda ()
1820 (with-current-buffer ,(current-buffer)
1821 (preview-buffer-restore-internal
1822 ',buffer-misc)))))
1823
1824 (defun desktop-buffer-preview (desktop-buffer-file-name
1825 desktop-buffer-name
1826 desktop-buffer-misc)
1827 "Hook function for restoring persistent previews into a buffer."
1828 (when (and desktop-buffer-file-name
1829 (file-readable-p desktop-buffer-file-name))
1830 (let ((buf (find-file-noselect desktop-buffer-file-name)))
1831 (if (eq (car desktop-buffer-misc) 'preview)
1832 (with-current-buffer buf
1833 (preview-buffer-restore desktop-buffer-misc)
1834 buf)
1835 buf))))
1836
1837 (eval-after-load "desktop"
1838 '(if (boundp 'desktop-buffer-mode-handlers)
1839 (add-to-list 'desktop-buffer-mode-handlers
1840 '(latex-mode . desktop-buffer-preview))
1841 (add-hook 'desktop-buffer-handlers '(lambda ()
1842 (desktop-buffer-preview
1843 desktop-buffer-file-name
1844 desktop-buffer-name
1845 desktop-buffer-misc)))))
1846
1847 (defcustom preview-auto-cache-preamble 'ask
1848 "*Whether to generate a preamble cache format automatically.
1849 Possible values are nil, t, and `ask'."
1850 :group 'preview-latex
1851 :type '(choice (const :tag "Cache" t)
1852 (const :tag "Don't cache" nil)
1853 (const :tag "Ask" ask)))
1854
1855 (defvar preview-dumped-alist nil
1856 "Alist of dumped masters.
1857 The elements are (NAME . ASSOC). NAME is the master file name
1858 \(without extension), ASSOC is what to do with regard to this
1859 format. Possible values: NIL means no format is available
1860 and none should be generated. T means no format is available,
1861 it should be generated on demand. If the value is a cons cell,
1862 the CAR of the cons cell is the command with which the format
1863 has been generated, and the CDR is some Emacs-flavor specific
1864 value used for maintaining a watch on possible changes of the
1865 preamble.")
1866
1867 (defun preview-cleanout-tempfiles ()
1868 "Clean out all directories and files with non-persistent data.
1869 This is called as a hook when exiting Emacs."
1870 (mapc #'preview-kill-buffer-cleanup (buffer-list))
1871 (mapc #'preview-format-kill preview-dumped-alist))
1872
1873 (defun preview-inactive-string (ov)
1874 "Generate before-string for an inactive preview overlay OV.
1875 This is for overlays where the source text has been clicked
1876 visible. For efficiency reasons it is expected that the buffer
1877 is already selected and unnarrowed."
1878 (concat
1879 (preview-make-clickable (overlay-get ov 'preview-map)
1880 preview-icon
1881 "\
1882 %s redisplays preview
1883 %s more options")
1884 ;; icon on separate line only for stuff starting on its own line
1885 (with-current-buffer (overlay-buffer ov)
1886 (save-excursion
1887 (save-restriction
1888 (widen)
1889 (goto-char (overlay-start ov))
1890 (if (bolp) "\n" ""))))))
1891
1892 (defun preview-dvipng-place-all ()
1893 "Place all images dvipng has created, if any.
1894 Deletes the dvi file when finished."
1895 (let (filename queued oldfiles snippet)
1896 (dolist (ov (prog1 preview-gs-queue (setq preview-gs-queue nil)))
1897 (when (and (setq queued (overlay-get ov 'queued))
1898 (setq snippet (aref (overlay-get ov 'queued) 2))
1899 (setq filename (preview-make-filename
1900 (format "prev%03d.%s"
1901 snippet preview-dvipng-image-type)
1902 TeX-active-tempdir)))
1903 (if (file-exists-p (car filename))
1904 (progn
1905 (overlay-put ov 'filenames (list filename))
1906 (preview-replace-active-icon
1907 ov
1908 (preview-create-icon (car filename)
1909 preview-dvipng-image-type
1910 (preview-ascent-from-bb
1911 (aref queued 0))
1912 (aref preview-colors 2)))
1913 (overlay-put ov 'queued nil))
1914 (push filename oldfiles)
1915 (overlay-put ov 'filenames nil)
1916 (push ov preview-gs-queue))))
1917 (if (setq preview-gs-queue (nreverse preview-gs-queue))
1918 (progn
1919 (preview-start-dvips preview-fast-conversion)
1920 (setq TeX-sentinel-function (lambda (process command)
1921 (preview-gs-dvips-sentinel
1922 process
1923 command
1924 t)))
1925 (dolist (ov preview-gs-queue)
1926 (setq snippet (aref (overlay-get ov 'queued) 2))
1927 (overlay-put ov 'filenames
1928 (list
1929 (preview-make-filename
1930 (or preview-ps-file
1931 (format "preview.%03d" snippet))
1932 TeX-active-tempdir))))
1933 (while (setq filename (pop oldfiles))
1934 (condition-case nil
1935 (preview-delete-file filename)
1936 (file-error nil))))
1937 (condition-case nil
1938 (let ((gsfile preview-gs-file))
1939 (delete-file
1940 (with-current-buffer TeX-command-buffer
1941 (funcall (car gsfile) "dvi"))))
1942 (file-error nil)))))
1943
1944 (defun preview-active-string (ov)
1945 "Generate before-string for active image overlay OV."
1946 (preview-make-clickable
1947 (overlay-get ov 'preview-map)
1948 (car (overlay-get ov 'preview-image))
1949 "%s opens text
1950 %s more options"))
1951
1952 (defun preview-make-filename (file tempdir)
1953 "Generate a preview filename from FILE and TEMPDIR.
1954 Filenames consist of a CONS-cell with absolute file name as CAR
1955 and TEMPDIR as CDR. TEMPDIR is a copy of `TeX-active-tempdir'
1956 with the directory name, the reference count and its top directory
1957 name elements. If FILE is already in that form, the file name itself
1958 gets converted into a CONS-cell with a name and a reference count."
1959 (if (consp file)
1960 (progn
1961 (if (consp (car file))
1962 (setcdr (car file) (1+ (cdr (car file))))
1963 (setcar file (cons (car file) 1)))
1964 file)
1965 (setcar (nthcdr 2 tempdir) (1+ (nth 2 tempdir)))
1966 (cons (expand-file-name file (nth 0 tempdir))
1967 tempdir)))
1968
1969 (defun preview-attach-filename (attached file)
1970 "Attaches the absolute file name ATTACHED to FILE."
1971 (if (listp (caar file))
1972 (setcar (car file) (cons attached (caar file)))
1973 (setcar (car file) (list attached (caar file))))
1974 file)
1975
1976 (defun preview-delete-file (file)
1977 "Delete a preview FILE.
1978 See `preview-make-filename' for a description of the data
1979 structure. If the containing directory becomes empty,
1980 it gets deleted as well."
1981 (let ((filename
1982 (if (consp (car file))
1983 (and (zerop
1984 (setcdr (car file) (1- (cdr (car file)))))
1985 (car (car file)))
1986 (car file))))
1987 (if filename
1988 (unwind-protect
1989 (if (listp filename)
1990 (dolist (elt filename) (delete-file elt))
1991 (delete-file filename))
1992 (let ((tempdir (cdr file)))
1993 (when tempdir
1994 (if (> (nth 2 tempdir) 1)
1995 (setcar (nthcdr 2 tempdir) (1- (nth 2 tempdir)))
1996 (setcdr file nil)
1997 (delete-directory (nth 0 tempdir)))))))))
1998
1999 (defvar preview-buffer-has-counters nil)
2000 (make-variable-buffer-local 'preview-buffer-has-counters)
2001
2002 (defun preview-place-preview (snippet start end
2003 box counters tempdir place-opts)
2004 "Generate and place an overlay preview image.
2005 This generates the filename for the preview
2006 snippet SNIPPET in the current buffer, and uses it for the
2007 region between START and END. BOX is an optional preparsed
2008 TeX bounding BOX passed on to the `place' hook.
2009 COUNTERS is the info about saved counter structures.
2010 TEMPDIR is a copy of `TeX-active-tempdir'.
2011 PLACE-OPTS are additional arguments passed into
2012 `preview-parse-messages'. Returns
2013 a list with additional info from the placement hook.
2014 Those lists get concatenated together and get passed
2015 to the close hook."
2016 (preview-clearout start end tempdir)
2017 (let ((ov (make-overlay start end nil nil nil)))
2018 (when (fboundp 'TeX-overlay-prioritize)
2019 (overlay-put ov 'priority (TeX-overlay-prioritize start end)))
2020 (overlay-put ov 'preview-map
2021 (preview-make-clickable
2022 nil nil nil
2023 `(lambda(event) (interactive "e")
2024 (preview-toggle ,ov 'toggle event))
2025 `(lambda(event) (interactive "e")
2026 (preview-context-menu ,ov event))))
2027 (overlay-put ov 'timestamp tempdir)
2028 (when (cdr counters)
2029 (overlay-put ov 'preview-counters counters)
2030 (setq preview-buffer-has-counters t))
2031 (prog1 (apply #'preview-call-hook 'place ov snippet box
2032 place-opts)
2033 (overlay-put ov 'strings
2034 (list (preview-active-string ov)))
2035 (preview-toggle ov t))))
2036
2037 ;; The following is a brutal hack. It relies on `begin' being let to
2038 ;; the start of the interesting area when TeX-region-create is being
2039 ;; called.
2040
2041 (defun preview-counter-find (begin)
2042 "Fetch the next preceding or next preview-counters property.
2043 Factored out because of compatibility macros XEmacs would
2044 not use in advice."
2045 ;; The following two lines are bug workaround for Emacs < 22.1.
2046 (if (markerp begin)
2047 (setq begin (marker-position begin)))
2048 (or (car (get-char-property begin 'preview-counters))
2049 (cdr (get-char-property (max (point-min)
2050 (1- begin))
2051 'preview-counters))
2052 (cdr (get-char-property
2053 (max (point-min)
2054 (1- (previous-single-char-property-change
2055 begin
2056 'preview-counters)))
2057 'preview-counters))
2058 (car (get-char-property
2059 (next-single-char-property-change begin 'preview-counters)
2060 'preview-counters))))
2061
2062 (defadvice TeX-region-create (around preview-counters)
2063 "Write out counter information to region."
2064 (let ((TeX-region-extra
2065 (concat
2066 (and (boundp 'begin)
2067 preview-buffer-has-counters
2068 (mapconcat
2069 #'identity
2070 (cons
2071 ""
2072 (preview-counter-find (symbol-value 'begin)))
2073 "\\setcounter"))
2074 TeX-region-extra)))
2075 ad-do-it))
2076
2077 (defun preview-reinstate-preview (tempdirlist timestamp start end
2078 image filename &optional counters)
2079 "Reinstate a single preview.
2080 This gets passed TEMPDIRLIST, a list consisting of the kind
2081 of entries used in `TeX-active-tempdir', and TIMESTAMP, the
2082 time stamp under which the file got read in. It returns an augmented
2083 list. START and END give the buffer location where the preview
2084 is to be situated, IMAGE the image to place there, and FILENAME
2085 the file to use: a triple consisting of filename, its temp directory
2086 and the corresponding topdir. COUNTERS is saved counter information,
2087 if any."
2088 (when
2089 (or (null filename) (file-readable-p (car filename)))
2090 (when filename
2091 (unless (equal (nth 1 filename) (car TeX-active-tempdir))
2092 (setq TeX-active-tempdir
2093 (or (assoc (nth 1 filename) tempdirlist)
2094 (car (push (append (cdr filename) (list 0))
2095 tempdirlist))))
2096 (setcar (cdr TeX-active-tempdir)
2097 (car (or (member (nth 1 TeX-active-tempdir)
2098 preview-temp-dirs)
2099 (progn
2100 (add-hook 'kill-emacs-hook
2101 #'preview-cleanout-tempfiles t)
2102 (push (nth 1 TeX-active-tempdir)
2103 preview-temp-dirs))))))
2104 (setcar (nthcdr 2 TeX-active-tempdir)
2105 (1+ (nth 2 TeX-active-tempdir)))
2106 (setcdr filename TeX-active-tempdir)
2107 (setq filename (list filename)))
2108 (let ((ov (make-overlay start end nil nil nil)))
2109 (when (fboundp 'TeX-overlay-prioritize)
2110 (overlay-put ov 'priority (TeX-overlay-prioritize start end)))
2111 (overlay-put ov 'preview-map
2112 (preview-make-clickable
2113 nil nil nil
2114 `(lambda(event) (interactive "e")
2115 (preview-toggle ,ov 'toggle event))
2116 `(lambda(event) (interactive "e")
2117 (preview-context-menu ,ov event))))
2118 (when counters
2119 (overlay-put
2120 ov 'preview-counters
2121 (cons
2122 (mapcar #'cdr
2123 (if (string= (car counters) "")
2124 preview-parsed-counters
2125 (setq preview-parsed-counters
2126 (preview-parse-counters (car counters)))))
2127 (mapcar #'cdr
2128 (if (string= (cdr counters) "")
2129 preview-parsed-counters
2130 (setq preview-parsed-counters
2131 (preview-parse-counters (cdr counters)))))))
2132 (setq preview-buffer-has-counters t))
2133 (overlay-put ov 'filenames filename)
2134 (overlay-put ov 'preview-image (cons (preview-import-image image)
2135 image))
2136 (overlay-put ov 'strings
2137 (list (preview-active-string ov)))
2138 (overlay-put ov 'timestamp timestamp)
2139 (preview-toggle ov t)))
2140 tempdirlist)
2141
2142 (defun preview-back-command (&optional nocomplex)
2143 "Move backward a TeX token.
2144 If NOCOMPLEX is set, only basic tokens and no argument sequences
2145 will be skipped over backwards."
2146 (let ((oldpos (point)) oldpoint)
2147 (condition-case nil
2148 (or (search-backward-regexp "\\(\\$\\$?\
2149 \\|\\\\[^a-zA-Z@]\
2150 \\|\\\\[a-zA-Z@]+\
2151 \\|\\\\begin[ \t]*{[^}]+}\
2152 \\)\\=" (line-beginning-position) t)
2153 nocomplex
2154 (if (eq ?\) (char-syntax (char-before)))
2155 (while
2156 (progn
2157 (setq oldpoint (point))
2158 (backward-sexp)
2159 (and (not (eq oldpoint (point)))
2160 (eq ?\( (char-syntax (char-after))))))
2161 (backward-char)))
2162 (error (goto-char oldpos)))))
2163
2164 (defcustom preview-required-option-list '("active" "tightpage" "auctex"
2165 (preview-preserve-counters
2166 "counters"))
2167 "Specifies required options passed to the preview package.
2168 These are passed regardless of whether there is an explicit
2169 \\usepackage of that package present."
2170 :group 'preview-latex
2171 :type preview-expandable-string)
2172
2173 (defcustom preview-preserve-counters nil
2174 "Try preserving counters for partial runs if set."
2175 :group 'preview-latex
2176 :type 'boolean)
2177
2178 (defcustom preview-default-option-list '("displaymath" "floats"
2179 "graphics" "textmath" "sections"
2180 "footnotes")
2181 "*Specifies default options to pass to preview package.
2182 These options are only used when the LaTeX document in question does
2183 not itself load the preview package, namely when you use preview
2184 on a document not configured for preview. \"auctex\", \"active\",
2185 \"dvips\" and \"delayed\" need not be specified here."
2186 :group 'preview-latex
2187 :type '(list (set :inline t :tag "Options known to work"
2188 :format "%t:\n%v%h" :doc
2189 "The above options are all the useful ones
2190 at the time of the release of this package.
2191 You should not need \"Other options\" unless you
2192 upgraded to a fancier version of just the LaTeX style.
2193 Please also note that `psfixbb' fails to have an effect if
2194 `preview-fast-conversion' or `preview-prefer-TeX-bb'
2195 are selected."
2196 (const "displaymath")
2197 (const "floats")
2198 (const "graphics")
2199 (const "textmath")
2200 (const "sections")
2201 (const "footnotes")
2202 (const "showlabels")
2203 (const "psfixbb"))
2204 (set :tag "Expert options" :inline t
2205 :format "%t:\n%v%h" :doc
2206 "Expert options should not be enabled permanently."
2207 (const "noconfig")
2208 (const "showbox")
2209 (const "tracingall"))
2210 (repeat :inline t :tag "Other options" (string))))
2211
2212 (defcustom preview-default-preamble
2213 '("\\RequirePackage[" ("," . preview-default-option-list)
2214 "]{preview}[2004/11/05]")
2215 "*Specifies default preamble code to add to a LaTeX document.
2216 If the document does not itself load the preview package, that is,
2217 when you use preview on a document not configured for preview, this
2218 list of LaTeX commands is inserted just before \\begin{document}."
2219 :group 'preview-latex
2220 :type preview-expandable-string)
2221
2222 (defcustom preview-LaTeX-command '("%`%l \"\\nonstopmode\\nofiles\
2223 \\PassOptionsToPackage{" ("," . preview-required-option-list) "}{preview}\
2224 \\AtBeginDocument{\\ifx\\ifPreview\\undefined"
2225 preview-default-preamble "\\fi}\"%' %t")
2226 "*Command used for starting a preview.
2227 See description of `TeX-command-list' for details."
2228 :group 'preview-latex
2229 :type preview-expandable-string)
2230
2231 (defun preview-goto-info-page ()
2232 "Read documentation for preview-latex in the info system."
2233 (interactive)
2234 (info "(preview-latex)"))
2235
2236 (eval-after-load 'info '(add-to-list 'Info-file-list-for-emacs
2237 '("preview" . "preview-latex")))
2238
2239 (defvar preview-map
2240 (let ((map (make-sparse-keymap)))
2241 (define-key map "\C-p" #'preview-at-point)
2242 (define-key map "\C-r" #'preview-region)
2243 (define-key map "\C-b" #'preview-buffer)
2244 (define-key map "\C-d" #'preview-document)
2245 (define-key map "\C-f" #'preview-cache-preamble)
2246 (define-key map "\C-c\C-f" #'preview-cache-preamble-off)
2247 (define-key map "\C-i" #'preview-goto-info-page)
2248 ;; (define-key map "\C-q" #'preview-paragraph)
2249 (define-key map "\C-e" #'preview-environment)
2250 (define-key map "\C-s" #'preview-section)
2251 (define-key map "\C-w" #'preview-copy-region-as-mml)
2252 (define-key map "\C-c\C-p" #'preview-clearout-at-point)
2253 (define-key map "\C-c\C-r" #'preview-clearout)
2254 (define-key map "\C-c\C-s" #'preview-clearout-section)
2255 (define-key map "\C-c\C-b" #'preview-clearout-buffer)
2256 (define-key map "\C-c\C-d" #'preview-clearout-document)
2257 map))
2258
2259 (defun preview-copy-text (ov)
2260 "Copy the text of OV into the kill buffer."
2261 (save-excursion
2262 (set-buffer (overlay-buffer ov))
2263 (copy-region-as-kill (overlay-start ov) (overlay-end ov))))
2264
2265 (defun preview-copy-mml (ov)
2266 "Copy an MML representation of OV into the kill buffer.
2267 This can be used to send inline images in mail and news when
2268 using MML mode."
2269 (when (catch 'badcolor
2270 (let ((str (car (preview-format-mml ov))))
2271 (if str
2272 (if (eq last-command 'kill-region)
2273 (kill-append str nil)
2274 (kill-new str))
2275 (error "No image file available")))
2276 nil)
2277 (let (preview-transparent-border)
2278 (preview-regenerate ov))))
2279
2280 (defun preview-copy-region-as-mml (start end)
2281 (interactive "r")
2282 (when (catch 'badcolor
2283 (let (str lst dont-ask)
2284 (dolist (ov (overlays-in start end))
2285 (when (setq str (preview-format-mml ov dont-ask))
2286 (setq dont-ask (cdr str))
2287 (and
2288 (>= (overlay-start ov) start)
2289 (<= (overlay-end ov) end)
2290 (push (list (- (overlay-start ov) start)
2291 (- (overlay-end ov) start)
2292 (car str)) lst))))
2293 (setq str (buffer-substring start end))
2294 (dolist (elt (nreverse (sort lst #'car-less-than-car)))
2295 (setq str (concat (substring str 0 (nth 0 elt))
2296 (nth 2 elt)
2297 (substring str (nth 1 elt)))))
2298 (if (eq last-command 'kill-region)
2299 (kill-append str nil)
2300 (kill-new str)))
2301 nil)
2302 (let (preview-transparent-border)
2303 (preview-region start end))))
2304
2305 (autoload 'mailcap-extension-to-mime "mailcap")
2306
2307 (defun preview-format-mml (ov &optional dont-ask)
2308 "Return an MML representation of OV as string.
2309 This can be used to send inline images in mail and news when
2310 using MML mode. If there is nothing current available,
2311 NIL is returned. If the image has a colored border and the
2312 user wants it removed when asked (unless DONT-ASK is set),
2313 'badcolor is thrown a t. The MML is returned in the car of the
2314 result, DONT-ASK in the cdr."
2315 (and (memq (overlay-get ov 'preview-state) '(active inactive))
2316 (not (overlay-get ov 'queued))
2317 (let* ((text (with-current-buffer (overlay-buffer ov)
2318 (buffer-substring (overlay-start ov)
2319 (overlay-end ov))))
2320 (image (cdr (overlay-get ov 'preview-image)))
2321 file type)
2322 (cond ((consp image)
2323 (and (not dont-ask)
2324 (nth 3 image)
2325 (if (y-or-n-p "Replace colored borders? ")
2326 (throw 'badcolor t)
2327 (setq dont-ask t)))
2328 (setq file (car (car (last (overlay-get ov 'filenames))))
2329 type (mailcap-extension-to-mime
2330 (file-name-extension file)))
2331 (cons
2332 (format "<#part %s
2333 description=\"%s\"
2334 filename=%s>
2335 <#/part>"
2336 (if type
2337 (format "type=\"%s\" disposition=inline" type)
2338 "disposition=attachment")
2339 (if (string-match "[\n\"]" text)
2340 "preview-latex image"
2341 text)
2342 (if (string-match "[ \n<>]" file)
2343 (concat "\"" file "\"")
2344 file))
2345 dont-ask))
2346 ((stringp image)
2347 (cons image dont-ask))))))
2348
2349 (defun preview-active-contents (ov)
2350 "Check whether we have a valid image associated with OV."
2351 (and (memq (overlay-get ov 'preview-state) '(active inactive)) t))
2352
2353 (defun preview-context-menu (ov ev)
2354 "Pop up a menu for OV at position EV."
2355 (popup-menu
2356 `("Preview"
2357 ["Toggle" (preview-toggle ,ov 'toggle ',ev)
2358 (preview-active-contents ,ov)]
2359 ["Regenerate" (preview-regenerate ,ov)]
2360 ["Remove" (preview-delete ,ov)]
2361 ["Copy text" (preview-copy-text ,ov)]
2362 ["Copy MIME" (preview-copy-mml ,ov)
2363 (preview-active-contents ,ov)])
2364 ev))
2365
2366 (defvar preview-TeX-style-dir)
2367
2368 (defun preview-TeX-style-cooked ()
2369 "Return `preview-TeX-style-dir' in cooked form.
2370 This will be fine for prepending to a `TEXINPUT' style
2371 environment variable, including an initial `.' at the front."
2372 (if (or (zerop (length preview-TeX-style-dir))
2373 (member (substring preview-TeX-style-dir -1) '(";" ":")))
2374 preview-TeX-style-dir
2375 (let ((sep
2376 (cond
2377 ((stringp TeX-kpathsea-path-delimiter)
2378 TeX-kpathsea-path-delimiter)
2379 ((string-match
2380 "\\`.[:]"
2381 (if (file-name-absolute-p preview-TeX-style-dir)
2382 preview-TeX-style-dir
2383 (expand-file-name preview-TeX-style-dir)))
2384 ";")
2385 (t ":"))))
2386 (concat "." sep preview-TeX-style-dir sep))))
2387
2388 (defun preview-set-texinputs (&optional remove)
2389 "Add `preview-TeX-style-dir' into `TEXINPUTS' variables.
2390 With prefix argument REMOVE, remove it again."
2391 (interactive "P")
2392 (let ((case-fold-search nil)
2393 (preview-TeX-style-dir (preview-TeX-style-cooked))
2394 pattern)
2395 (if remove
2396 (progn
2397 (setq pattern (concat "\\`\\(TEXINPUTS[^=]*\\)=\\(.*\\)"
2398 (regexp-quote preview-TeX-style-dir)))
2399 (dolist (env (copy-sequence process-environment))
2400 (if (string-match pattern env)
2401 (setenv (match-string 1 env)
2402 (and (or (< (match-beginning 2) (match-end 2))
2403 (< (match-end 0) (length env)))
2404 (concat (match-string 2 env)
2405 (substring env (match-end 0))))))))
2406 (setq pattern (regexp-quote preview-TeX-style-dir))
2407 (dolist (env (cons "TEXINPUTS=" (copy-sequence process-environment)))
2408 (if (string-match "\\`\\(TEXINPUTS[^=]*\\)=" env)
2409 (unless (string-match pattern env)
2410 (setenv (match-string 1 env)
2411 (concat preview-TeX-style-dir
2412 (substring env (match-end 0))))))))))
2413
2414 (defcustom preview-TeX-style-dir nil
2415 "This variable contains the location of uninstalled TeX styles.
2416 If this is nil, the preview styles are considered to be part of
2417 the installed TeX system.
2418
2419 Otherwise, it can either just specify an absolute directory, or
2420 it can be a complete TEXINPUTS specification. If it is the
2421 latter, it has to be followed by the character with which
2422 kpathsea separates path components, either `:' on Unix-like
2423 systems, or `;' on Windows-like systems. And it should be
2424 preceded with .: or .; accordingly in order to have . first in
2425 the search path.
2426
2427 The `TEXINPUT' environment type variables will get this prepended
2428 at load time calling \\[preview-set-texinputs] to reflect this.
2429 You can permanently install the style files using
2430 \\[preview-install-styles].
2431
2432 Don't set this variable other than with customize so that its
2433 changes get properly reflected in the environment."
2434 :group 'preview-latex
2435 :set (lambda (var value)
2436 (and (boundp var)
2437 (symbol-value var)
2438 (preview-set-texinputs t))
2439 (set var value)
2440 (and (symbol-value var)
2441 (preview-set-texinputs)))
2442 :type '(choice (const :tag "Installed" nil)
2443 (string :tag "Style directory or TEXINPUTS path")))
2444
2445 ;;;###autoload
2446 (defun preview-install-styles (dir &optional force-overwrite
2447 force-save)
2448 "Installs the TeX style files into a permanent location.
2449 This must be in the TeX search path. If FORCE-OVERWRITE is greater
2450 than 1, files will get overwritten without query, if it is less
2451 than 1 or nil, the operation will fail. The default of 1 for interactive
2452 use will query.
2453
2454 Similarly FORCE-SAVE can be used for saving
2455 `preview-TeX-style-dir' to record the fact that the uninstalled
2456 files are no longer needed in the search path."
2457 (interactive "DPermanent location for preview TeX styles
2458 pp")
2459 (unless preview-TeX-style-dir
2460 (error "Styles are already installed"))
2461 (dolist (file (or
2462 (condition-case nil
2463 (directory-files
2464 (progn
2465 (string-match
2466 "\\`\\(\\.[:;]\\)?\\(.*?\\)\\([:;]\\)?\\'"
2467 preview-TeX-style-dir)
2468 (match-string 2 preview-TeX-style-dir))
2469 t "\\.\\(sty\\|def\\|cfg\\)\\'")
2470 (error nil))
2471 (error "Can't find files to install")))
2472 (copy-file file dir (cond ((eq force-overwrite 1) 1)
2473 ((numberp force-overwrite)
2474 (> force-overwrite 1))
2475 (t force-overwrite))))
2476 (if (cond ((eq force-save 1)
2477 (y-or-n-p "Stop using non-installed styles permanently "))
2478 ((numberp force-save)
2479 (> force-save 1))
2480 (t force-save))
2481 (customize-save-variable 'preview-TeX-style-dir nil)
2482 (customize-set-variable 'preview-TeX-style-dir nil)))
2483
2484 ;;;###autoload
2485 (defun LaTeX-preview-setup ()
2486 "Hook function for embedding the preview package into AUCTeX.
2487 This is called by `LaTeX-mode-hook' and changes AUCTeX variables
2488 to add the preview functionality."
2489 (remove-hook 'LaTeX-mode-hook #'LaTeX-preview-setup)
2490 (add-hook 'LaTeX-mode-hook #'preview-mode-setup)
2491 (define-key LaTeX-mode-map "\C-c\C-p" preview-map)
2492 (easy-menu-define preview-menu LaTeX-mode-map
2493 "This is the menu for preview-latex."
2494 '("Preview"
2495 "Generate previews"
2496 ["(or toggle) at point" preview-at-point]
2497 ["for environment" preview-environment]
2498 ["for section" preview-section]
2499 ["for region" preview-region (preview-mark-active)]
2500 ["for buffer" preview-buffer]
2501 ["for document" preview-document]
2502 "---"
2503 "Remove previews"
2504 ["at point" preview-clearout-at-point]
2505 ["from section" preview-clearout-section]
2506 ["from region" preview-clearout (preview-mark-active)]
2507 ["from buffer" preview-clearout-buffer]
2508 ["from document" preview-clearout-document]
2509 "---"
2510 "Turn preamble cache"
2511 ["on" preview-cache-preamble]
2512 ["off" preview-cache-preamble-off]
2513 "---"
2514 ("Customize"
2515 ["Browse options"
2516 (customize-group 'preview)]
2517 ["Extend this menu"
2518 (easy-menu-add-item
2519 nil '("Preview")
2520 (customize-menu-create 'preview))])
2521 ["Read documentation" preview-goto-info-page]
2522 ["Report Bug" preview-report-bug]))
2523 (if (eq major-mode 'latex-mode)
2524 (preview-mode-setup))
2525 (if (boundp 'desktop-buffer-misc)
2526 (preview-buffer-restore desktop-buffer-misc)))
2527
2528 (defun preview-clean-subdir (dir)
2529 "Cleans out a temporary DIR with preview image files."
2530 (condition-case err
2531 (progn
2532 (mapc #'delete-file
2533 (directory-files dir t "\\`pr" t))
2534 (delete-directory dir))
2535 (error (message "Deletion of `%s' failed: %s" dir
2536 (error-message-string err)))))
2537
2538 (defun preview-clean-topdir (topdir)
2539 "Cleans out TOPDIR from temporary directories.
2540 This does not erase the directory itself since its permissions
2541 might be needed for colloborative work on common files."
2542 (mapc #'preview-clean-subdir
2543 (condition-case nil
2544 (directory-files topdir t "\\`tmp" t)
2545 (file-error nil))))
2546
2547 (defun preview-create-subdirectory ()
2548 "Create a temporary subdir for the current TeX process.
2549 If necessary, generates a fitting top
2550 directory or cleans out an existing one (if not yet
2551 visited in this session), then returns the name of
2552 the created subdirectory relative to the master directory,
2553 in shell-quoted form. `TeX-active-tempdir' is
2554 set to the corresponding TEMPDIR descriptor as described
2555 in `preview-make-filename'. The directory is registered
2556 in `preview-temp-dirs' in order not to be cleaned out
2557 later while in use."
2558 (let ((topdir (expand-file-name (TeX-active-master "prv"))))
2559 (if (file-directory-p topdir)
2560 (unless (member topdir preview-temp-dirs)
2561 ;; Cleans out the top preview directory by
2562 ;; removing subdirs possibly left from a previous session.
2563 (preview-clean-topdir topdir)
2564 (push topdir preview-temp-dirs))
2565 (make-directory topdir)
2566 (add-to-list 'preview-temp-dirs topdir))
2567 (add-hook 'kill-emacs-hook #'preview-cleanout-tempfiles t)
2568 (setq TeX-active-tempdir
2569 (list (make-temp-file (expand-file-name
2570 "tmp" (file-name-as-directory topdir)) t)
2571 topdir
2572 0))
2573 (shell-quote-argument
2574 (concat (file-name-as-directory (file-name-nondirectory topdir))
2575 (file-name-nondirectory (nth 0 TeX-active-tempdir))))))
2576
2577 ;; Hook into TeX immediately if it's loaded, use LaTeX-mode-hook if not.
2578 (if (featurep 'latex)
2579 (LaTeX-preview-setup)
2580 (add-hook 'LaTeX-mode-hook #'LaTeX-preview-setup))
2581
2582 ;;;###autoload (add-hook 'LaTeX-mode-hook #'LaTeX-preview-setup)
2583
2584 (defun preview-parse-counters (string)
2585 "Extract counter information from STRING."
2586 (let ((list preview-parsed-counters) (pos 0))
2587 (while (eq pos (string-match " *\\({\\([^{}]+\\)}{[-0-9]+}\\)" string pos))
2588 (setcdr (or (assoc (match-string 2 string) list)
2589 (car (push (list (match-string 2 string)) list)))
2590 (match-string 1 string))
2591 (setq pos (match-end 1)))
2592 list))
2593
2594 (defun preview-parse-tightpage (string)
2595 "Build tightpage vector from STRING,"
2596 (read (concat "[" string "]")))
2597
2598 (defvar preview-parse-variables
2599 '(("Fontsize" preview-parsed-font-size
2600 "\\` *\\([0-9.]+\\)pt\\'" 1 string-to-number)
2601 ("Magnification" preview-parsed-magnification
2602 "\\` *\\([0-9]+\\)\\'" 1 string-to-number)
2603 ("PDFoutput" preview-parsed-pdfoutput
2604 "" 0 stringp)
2605 ("Counters" preview-parsed-counters
2606 ".*" 0 preview-parse-counters)
2607 ("Tightpage" preview-parsed-tightpage
2608 "\\` *\\(-?[0-9]+ *\\)\\{4\\}\\'" 0 preview-parse-tightpage)))
2609
2610 (defun preview-error-quote (string run-coding-system)
2611 "Turn STRING with potential ^^ sequences into a regexp.
2612 To preserve sanity, additional ^ prefixes are matched literally,
2613 so the character represented by ^^^ preceding extended characters
2614 will not get matched, usually."
2615 (let (output case-fold-search)
2616 (when (featurep 'mule)
2617 (setq string (encode-coding-string string run-coding-system)))
2618 (while (string-match "\\^\\{2,\\}\\(\\([@-_?]\\)\\|[8-9a-f][0-9a-f]\\)"
2619 string)
2620 (setq output
2621 (concat output
2622 (regexp-quote (substring string
2623 0
2624 (- (match-beginning 1) 2)))
2625 (if (match-beginning 2)
2626 (concat
2627 "\\(?:" (regexp-quote
2628 (substring string
2629 (- (match-beginning 1) 2)
2630 (match-end 0)))
2631 "\\|"
2632 (char-to-string
2633 (logxor (aref string (match-beginning 2)) 64))
2634 "\\)")
2635 (char-to-string
2636 (string-to-number (match-string 1 string) 16))))
2637 string (substring string (match-end 0))))
2638 (setq output (concat output (regexp-quote string)))
2639 (if (featurep 'mule)
2640 (decode-coding-string output
2641 (or (and (boundp 'TeX-japanese-process-output-coding-system)
2642 TeX-japanese-process-output-coding-system)
2643 buffer-file-coding-system))
2644 output)))
2645
2646 (defun preview-parse-messages (open-closure)
2647 "Turn all preview snippets into overlays.
2648 This parses the pseudo error messages from the preview
2649 document style for LaTeX. OPEN-CLOSURE is called once
2650 it is certain that we have a valid output file, and it has
2651 to return in its CAR the PROCESS parameter for the CLOSE
2652 call, and in its CDR the final stuff for the placement hook."
2653 (with-temp-message "locating previews..."
2654 (let (TeX-error-file TeX-error-offset snippet box counters
2655 file line
2656 (lsnippet 0) lstart (lfile "") lline lbuffer lpoint
2657 lcounters
2658 string after-string error context-start
2659 context offset
2660 parsestate (case-fold-search nil)
2661 (run-buffer (current-buffer))
2662 (run-coding-system preview-coding-system)
2663 (run-directory default-directory)
2664 tempdir
2665 close-data
2666 open-data
2667 fast-hook
2668 slow-hook)
2669 ;; clear parsing variables
2670 (dolist (var preview-parse-variables)
2671 (set (nth 1 var) nil))
2672 (goto-char (point-min))
2673 (unwind-protect
2674 (progn
2675 (while
2676 (re-search-forward "\
2677 ^\\(!\\|\\(.*?\\):[0-9]+:\\) \\|\
2678 \(\\(/*\
2679 \\(?:\\.+[^()\r\n{} /]*\\|[^()\r\n{} ./]+\
2680 \\(?: [^()\r\n{} ./]+\\)*\\(?:\\.[-0-9a-zA-Z_.]*\\)?\\)\
2681 \\(?:/+\\(?:\\.+[^()\r\n{} /]*\\|[^()\r\n{} ./]+\
2682 \\(?: [^()\r\n{} ./]+\\)*\\(?:\\.[-0-9a-zA-Z_.]*\\)?\\)?\\)*\\)\
2683 )*\\(?: \\|\r?$\\)\\|\
2684 \\()+\\)\\|\
2685 !\\(?:offset(\\([---0-9]+\\))\\|\
2686 name(\\([^)]+\\))\\)\\|\
2687 ^Preview: \\([a-zA-Z]+\\) \\([^\n\r]*\\)\r?$" nil t)
2688 ;;; Ok, here is a line by line breakdown:
2689 ;;; match-alternative 1:
2690 ;;; error indicator for TeX error, either style.
2691 ;;; match-alternative 2:
2692 ;;; The same, but file-line-error-style, matching on file name.
2693 ;;; match-alternative 3:
2694 ;;; Too ugly to describe in detail. In short, we try to catch file
2695 ;;; names built from path components that don't contain spaces or
2696 ;;; other special characters once the file extension has started.
2697 ;;;
2698 ;;; Position for searching immediately after the file name so as to
2699 ;;; not miss closing parens or something.
2700 ;;; (match-string 3) is the file name.
2701 ;;; match-alternative 4:
2702 ;;; )+\( \|$\)
2703 ;;; a closing paren followed by the end of line or a space: a just
2704 ;;; closed file.
2705 ;;; match-alternative 5 (wrapped into one shy group with
2706 ;;; match-alternative 6, so that the match on first char is slightly
2707 ;;; faster):
2708 ;;; !offset(\([---0-9]+\))
2709 ;;; an AUCTeX offset message. (match-string 5) is the offset itself
2710 ;;; !name(\([^)]+\))
2711 ;;; an AUCTeX file name message. (match-string 6) is the file name
2712 ;;; TODO: Actually, the latter two should probably again match only
2713 ;;; after a space or newline, since that it what \message produces.
2714 ;;;disabled in prauctex.def:
2715 ;;;\(?:Ov\|Und\)erfull \\.*[0-9]*--[0-9]*
2716 ;;;\(?:.\{79\}
2717 ;;;\)*.*$\)\|
2718 ;;; This would have caught overfull box messages that consist of
2719 ;;; several lines of context all with 79 characters in length except
2720 ;;; of the last one. prauctex.def kills all such messages.
2721 (setq file (match-string-no-properties 2))
2722 (cond
2723 ((match-beginning 1)
2724 (if (looking-at "\
2725 \\(?:Preview\\|Package Preview Error\\): Snippet \\([---0-9]+\\) \\(started\\|ended\\(\
2726 \\.? *(\\([---0-9]+\\)\\+\\([---0-9]+\\)x\\([---0-9]+\\))\\)?\\)\\.")
2727 (progn
2728 (when file
2729 (unless TeX-error-file
2730 (push nil TeX-error-file)
2731 (push nil TeX-error-offset))
2732 (unless (car TeX-error-offset)
2733 (rplaca TeX-error-file file)))
2734 (setq snippet (string-to-number (match-string 1))
2735 box (unless
2736 (string= (match-string 2) "started")
2737 (if (match-string 4)
2738 (mapcar #'(lambda (x)
2739 (* (preview-get-magnification)
2740 (string-to-number x)))
2741 (list
2742 (match-string 4)
2743 (match-string 5)
2744 (match-string 6)))
2745 t))
2746 counters (mapcar #'cdr preview-parsed-counters)
2747 error (progn
2748 (setq lpoint (point))
2749 (end-of-line)
2750 (buffer-substring lpoint (point)))
2751
2752 ;; And the context for the help window.
2753 context-start (point)
2754
2755 ;; And the line number to position the cursor.
2756 ;;; variant 1: profiling seems to indicate the regexp-heavy solution
2757 ;;; to be favorable. Removing incomplete characters from the error
2758 ;;; context is an absolute nuisance.
2759 line (and (re-search-forward "\
2760 ^l\\.\\([0-9]+\\) \\(\\.\\.\\.\\(?:\\^*\\(?:[89a-f][0-9a-f]\\|[]@-\\_?]\\)\\|\
2761 \[0-9a-f]?\\)\\)?\\([^\n\r]*?\\)\r?
2762 \\([^\n\r]*?\\)\\(\\(?:\\^+[89a-f]?\\)?\\.\\.\\.\\)?\r?$" nil t)
2763 (string-to-number (match-string 1)))
2764 ;; And a string of the context to search for.
2765 string (and line (match-string 3))
2766 after-string (and line (buffer-substring
2767 (+ (match-beginning 4)
2768 (- (match-end 3)
2769 (match-beginning 0)))
2770 (match-end 4)))
2771
2772 ;; And we have now found to the end of the context.
2773 context (buffer-substring context-start (point))
2774 ;; We may use these in another buffer.
2775 offset (or (car TeX-error-offset) 0)
2776 file (car TeX-error-file))
2777 (when (and (stringp file)
2778 (or (string= file "<none>")
2779 (TeX-match-extension file)))
2780 ;; if we are the first time round, check for fast hooks:
2781 (when (null parsestate)
2782 (setq open-data
2783 (save-excursion (funcall open-closure))
2784 tempdir TeX-active-tempdir)
2785 (dolist
2786 (lst (if (listp TeX-translate-location-hook)
2787 TeX-translate-location-hook
2788 (list TeX-translate-location-hook)))
2789 (let ((fast
2790 (and (symbolp lst)
2791 (get lst 'TeX-translate-via-list))))
2792 (if fast
2793 (setq fast-hook
2794 (nconc fast-hook (list fast)))
2795 (setq slow-hook
2796 (nconc slow-hook (list lst)))))))
2797 (condition-case err
2798 (save-excursion (run-hooks 'slow-hook))
2799 (error (preview-log-error err "Translation hook")))
2800 (push (vector file (+ line offset)
2801 string after-string
2802 snippet box counters) parsestate)))
2803 ;; else normal error message
2804 (forward-line)
2805 (re-search-forward "^l\\.[0-9]" nil t)
2806 (forward-line 2)))
2807 ((match-beginning 3)
2808 ;; New file -- Push on stack
2809 (push (match-string-no-properties 3) TeX-error-file)
2810 (push nil TeX-error-offset)
2811 (goto-char (match-end 3)))
2812 ((match-beginning 4)
2813 ;; End of file -- Pop from stack
2814 (when (> (length TeX-error-file) 1)
2815 (pop TeX-error-file)
2816 (pop TeX-error-offset))
2817 (goto-char (1+ (match-beginning 0))))
2818 ((match-beginning 5)
2819 ;; Hook to change line numbers
2820 (setq TeX-error-offset
2821 (list (string-to-number (match-string 5)))))
2822 ((match-beginning 6)
2823 ;; Hook to change file name
2824 (setq TeX-error-file (list (match-string-no-properties 6))))
2825 ((match-beginning 7)
2826 (let ((var
2827 (assoc (match-string-no-properties 7)
2828 preview-parse-variables))
2829 (offset (- (match-beginning 0) (match-beginning 8)))
2830 (str (match-string-no-properties 8)))
2831 ;; paste together continuation lines:
2832 (while (= (- (length str) offset) 79)
2833 (search-forward-regexp "^\\([^\n\r]*\\)\r?$")
2834 (setq offset (- (length str))
2835 str (concat str (match-string-no-properties 1))))
2836 (when (and var
2837 (string-match (nth 2 var) str))
2838 (set (nth 1 var)
2839 (funcall (nth 4 var)
2840 (match-string-no-properties
2841 (nth 3 var)
2842 str))))))))
2843 (when (null parsestate)
2844 (error "LaTeX found no preview images")))
2845 (unwind-protect
2846 (save-excursion
2847 (setq parsestate (nreverse parsestate))
2848 (condition-case err
2849 (dolist (fun fast-hook)
2850 (setq parsestate
2851 (save-excursion (funcall fun parsestate))))
2852 (error (preview-log-error err "Fast translation hook")))
2853 (setq snippet 0)
2854 (dolist (state parsestate)
2855 (setq lsnippet snippet
2856 file (aref state 0)
2857 line (aref state 1)
2858 string (aref state 2)
2859 after-string (aref state 3)
2860 snippet (aref state 4)
2861 box (aref state 5)
2862 counters (aref state 6))
2863 (unless (string= lfile file)
2864 (set-buffer (if (string= file "<none>")
2865 (with-current-buffer run-buffer
2866 TeX-command-buffer)
2867 (find-file-noselect
2868 (expand-file-name file run-directory))))
2869 (setq lfile file))
2870 (save-excursion
2871 (save-restriction
2872 (widen)
2873 ;; a fast hook might have positioned us already:
2874 (if (number-or-marker-p string)
2875 (progn
2876 (goto-char string)
2877 (setq lpoint
2878 (if (number-or-marker-p after-string)
2879 after-string
2880 (line-beginning-position))))
2881 (if (and (eq (current-buffer) lbuffer)
2882 (<= lline line))
2883 ;; while Emacs does the perfectly correct
2884 ;; thing even when when the line differences
2885 ;; get zero or negative, I don't trust this
2886 ;; to be universally the case across other
2887 ;; implementations. Besides, if the line
2888 ;; number gets smaller again, we are probably
2889 ;; rereading the file, and restarting from
2890 ;; the beginning will probably be faster.
2891 (progn
2892 (goto-char lpoint)
2893 (if (/= lline line)
2894 (if (eq selective-display t)
2895 (re-search-forward "[\n\C-m]" nil
2896 'end
2897 (- line lline))
2898 (forward-line (- line lline)))))
2899 (goto-line line))
2900 (setq lpoint (point))
2901 (cond
2902 ((search-forward (concat string after-string)
2903 (line-end-position) t)
2904 (backward-char (length after-string)))
2905 ;;ok, transform ^^ sequences
2906 ((search-forward-regexp
2907 (concat "\\("
2908 (setq string
2909 (preview-error-quote
2910 string
2911 run-coding-system))
2912 "\\)"
2913 (setq after-string
2914 (preview-error-quote
2915 after-string
2916 run-coding-system)))
2917 (line-end-position) t)
2918 (goto-char (match-end 1)))
2919 ((search-forward-regexp
2920 (concat "\\("
2921 (if (string-match
2922 "^[^\0-\177]\\{1,6\\}" string)
2923 (setq string
2924 (substring string (match-end 0)))
2925 string)
2926 "\\)"
2927 (if (string-match
2928 "[^\0-\177]\\{1,6\\}$" after-string)
2929 (setq after-string
2930 (substring after-string
2931 0 (match-beginning 0)))))
2932 (line-end-position) t)
2933 (goto-char (match-end 1)))
2934 (t (search-forward-regexp
2935 string
2936 (line-end-position) t))))
2937 (setq lline line
2938 lbuffer (current-buffer))
2939 (if box
2940 (progn
2941 (if (and lstart (= snippet lsnippet))
2942 (setq close-data
2943 (nconc
2944 (preview-place-preview
2945 snippet
2946 (save-excursion
2947 (preview-back-command
2948 (= (prog1 (point)
2949 (goto-char lstart))
2950 lstart))
2951 (point))
2952 (point)
2953 (preview-TeX-bb box)
2954 (cons lcounters counters)
2955 tempdir
2956 (cdr open-data))
2957 close-data))
2958 (with-current-buffer run-buffer
2959 (preview-log-error
2960 (list 'error
2961 (format
2962 "End of Preview snippet %d unexpected"
2963 snippet)) "Parser")))
2964 (setq lstart nil))
2965 ;; else-part of if box
2966 (setq lstart (point) lcounters counters)
2967 ;; >= because snippets in between might have
2968 ;; been ignored because of TeX-default-extension
2969 (unless (>= snippet (1+ lsnippet))
2970 (with-current-buffer run-buffer
2971 (preview-log-error
2972 (list 'error
2973 (format
2974 "Preview snippet %d out of sequence"
2975 snippet)) "Parser"))))))))
2976 (preview-call-hook 'close (car open-data) close-data))))))
2977
2978 (defun preview-get-geometry ()
2979 "Transfer display geometry parameters from current display.
2980 Returns list of scale, resolution and colors. Calculation
2981 is done in current buffer."
2982 (condition-case err
2983 (let* ((geometry
2984 (list (preview-hook-enquiry preview-scale-function)
2985 (cons (/ (* 25.4 (display-pixel-width))
2986 (display-mm-width))
2987 (/ (* 25.4 (display-pixel-height))
2988 (display-mm-height)))
2989 (preview-get-colors)))
2990 (preview-min-spec
2991 (* (cdr (nth 1 geometry))
2992 (/
2993 (preview-inherited-face-attribute
2994 'preview-reference-face :height 'default)
2995 720.0))))
2996 (setq preview-icon (preview-make-image 'preview-icon-specs)
2997 preview-error-icon (preview-make-image
2998 'preview-error-icon-specs)
2999 preview-nonready-icon (preview-make-image
3000 'preview-nonready-icon-specs))
3001 geometry)
3002 (error (error "Display geometry unavailable: %s"
3003 (error-message-string err)))))
3004
3005 (defun preview-set-geometry (geometry)
3006 "Set geometry variables from GEOMETRY.
3007 Buffer-local `preview-scale', `preview-resolution',
3008 and `preview-colors' are set as given."
3009 (setq preview-scale (nth 0 geometry)
3010 preview-resolution (nth 1 geometry)
3011 preview-colors (nth 2 geometry)))
3012
3013 (defun preview-start-dvipng ()
3014 "Start a DviPNG process.."
3015 (let* ((file preview-gs-file)
3016 tempdir
3017 (res (/ (* (car preview-resolution)
3018 (preview-hook-enquiry preview-scale))
3019 (preview-get-magnification)))
3020 (resolution (format " -D%d " res))
3021 (colors (preview-dvipng-color-string preview-colors res))
3022 (command (with-current-buffer TeX-command-buffer
3023 (prog1
3024 (concat (TeX-command-expand preview-dvipng-command
3025 (car file))
3026 " " colors resolution)
3027 (setq tempdir TeX-active-tempdir))))
3028 (name "Preview-DviPNG"))
3029 (setq TeX-active-tempdir tempdir)
3030 (goto-char (point-max))
3031 (insert-before-markers "Running `" name "' with ``" command "''\n")
3032 (setq mode-name name)
3033 (setq TeX-sentinel-function
3034 (lambda (process name) (message "%s: done." name)))
3035 (if TeX-process-asynchronous
3036 (let ((process (start-process name (current-buffer) TeX-shell
3037 TeX-shell-command-option
3038 command)))
3039 (if TeX-after-start-process-function
3040 (funcall TeX-after-start-process-function process))
3041 (TeX-command-mode-line process)
3042 (set-process-filter process 'TeX-command-filter)
3043 (set-process-sentinel process 'TeX-command-sentinel)
3044 (set-marker (process-mark process) (point-max))
3045 (push process compilation-in-progress)
3046 (sit-for 0)
3047 process)
3048 (setq mode-line-process ": run")
3049 (set-buffer-modified-p (buffer-modified-p))
3050 (sit-for 0) ; redisplay
3051 (call-process TeX-shell nil (current-buffer) nil
3052 TeX-shell-command-option
3053 command))))
3054
3055 (defun preview-start-dvips (&optional fast)
3056 "Start a DviPS process.
3057 If FAST is set, do a fast conversion."
3058 (let* ((file preview-gs-file)
3059 tempdir
3060 (command (with-current-buffer TeX-command-buffer
3061 (prog1
3062 (TeX-command-expand (if fast
3063 preview-fast-dvips-command
3064 preview-dvips-command)
3065 (car file))
3066 (setq tempdir TeX-active-tempdir))))
3067 (name "Preview-DviPS"))
3068 (setq TeX-active-tempdir tempdir)
3069 (setq preview-ps-file (and fast
3070 (preview-make-filename
3071 (preview-make-filename
3072 "preview.ps" tempdir) tempdir)))
3073 (goto-char (point-max))
3074 (insert-before-markers "Running `" name "' with ``" command "''\n")
3075 (setq mode-name name)
3076 (setq TeX-sentinel-function
3077 (lambda (process name) (message "%s: done." name)))
3078 (if TeX-process-asynchronous
3079 (let ((process (start-process name (current-buffer) TeX-shell
3080 TeX-shell-command-option
3081 command)))
3082 (if TeX-after-start-process-function
3083 (funcall TeX-after-start-process-function process))
3084 (TeX-command-mode-line process)
3085 (set-process-filter process 'TeX-command-filter)
3086 (set-process-sentinel process 'TeX-command-sentinel)
3087 (set-marker (process-mark process) (point-max))
3088 (push process compilation-in-progress)
3089 (sit-for 0)
3090 process)
3091 (setq mode-line-process ": run")
3092 (set-buffer-modified-p (buffer-modified-p))
3093 (sit-for 0) ; redisplay
3094 (call-process TeX-shell nil (current-buffer) nil
3095 TeX-shell-command-option
3096 command))))
3097
3098 (defun preview-start-pdf2dsc ()
3099 "Start a PDF2DSC process."
3100 (let* ((file preview-gs-file)
3101 tempdir
3102 pdfsource
3103 (command (with-current-buffer TeX-command-buffer
3104 (prog1
3105 (TeX-command-expand preview-pdf2dsc-command
3106 (car file))
3107 (setq tempdir TeX-active-tempdir
3108 pdfsource (funcall `,(car file) "pdf")))))
3109 (name "Preview-PDF2DSC"))
3110 (setq TeX-active-tempdir tempdir)
3111 (setq preview-ps-file (preview-attach-filename
3112 pdfsource
3113 (preview-make-filename
3114 (preview-make-filename
3115 "preview.dsc" tempdir) tempdir)))
3116 (goto-char (point-max))
3117 (insert-before-markers "Running `" name "' with ``" command "''\n")
3118 (setq mode-name name)
3119 (setq TeX-sentinel-function
3120 (lambda (process name) (message "%s: done." name)))
3121 (if TeX-process-asynchronous
3122 (let ((process (start-process name (current-buffer) TeX-shell
3123 TeX-shell-command-option
3124 command)))
3125 (if TeX-after-start-process-function
3126 (funcall TeX-after-start-process-function process))
3127 (TeX-command-mode-line process)
3128 (set-process-filter process 'TeX-command-filter)
3129 (set-process-sentinel process 'TeX-command-sentinel)
3130 (set-marker (process-mark process) (point-max))
3131 (push process compilation-in-progress)
3132 (sit-for 0)
3133 process)
3134 (setq mode-line-process ": run")
3135 (set-buffer-modified-p (buffer-modified-p))
3136 (sit-for 0) ; redisplay
3137 (call-process TeX-shell nil (current-buffer) nil
3138 TeX-shell-command-option
3139 command))))
3140
3141 (defun preview-TeX-inline-sentinel (process name)
3142 "Sentinel function for preview.
3143 See `TeX-sentinel-function' and `set-process-sentinel'
3144 for definition of PROCESS and NAME."
3145 (if process (TeX-format-mode-line process))
3146 (let ((status (process-status process)))
3147 (if (memq status '(signal exit))
3148 (delete-process process))
3149 (when (eq status 'exit)
3150 (save-excursion
3151 (goto-char (point-max))
3152 (forward-line -1)
3153 (if (search-forward "abnormally with code 1" nil t)
3154 (replace-match "as expected with code 1" t t)
3155 (if (search-forward "finished" nil t)
3156 (insert " with nothing to show"))))
3157 (condition-case err
3158 (preview-call-hook 'open)
3159 (error (preview-log-error err "LaTeX" process)))
3160 (preview-reraise-error process))))
3161
3162 (defcustom preview-format-extensions '(".fmt" ".efmt")
3163 "Possible extensions for format files.
3164 Those are just needed for cleanup."
3165 :group 'preview-latex
3166 :type '(repeat string))
3167
3168 (defun preview-format-kill (format-cons)
3169 "Kill a cached format.
3170 FORMAT-CONS is intended to be an element of `preview-dumped-alist'.
3171 Tries through `preview-format-extensions'."
3172 (dolist (ext preview-format-extensions)
3173 (condition-case nil
3174 (delete-file (preview-dump-file-name (concat (car format-cons) ext)))
3175 (file-error nil))))
3176
3177 (defun preview-dump-file-name (file)
3178 "Make a file name suitable for dumping from FILE."
3179 (if file
3180 (concat (file-name-directory file)
3181 "prv_"
3182 (progn
3183 (setq file (file-name-nondirectory file))
3184 (while (string-match " " file)
3185 (setq file (replace-match "_" t t file)))
3186 file))
3187 "prv_texput"))
3188
3189 (defun preview-do-replacements (string replacements)
3190 "Perform replacements in string.
3191 STRING is the input string, REPLACEMENTS is a list of replacements.
3192 A replacement is a cons-cell, where the car is the match string,
3193 and the cdr is a list of strings or symbols. Symbols get dereferenced,
3194 and strings get evaluated as replacement strings."
3195 (let (rep case-fold-search)
3196 (while replacements
3197 (setq rep (pop replacements))
3198 (cond ((symbolp rep)
3199 (setq string (preview-do-replacements
3200 string (symbol-value rep))))
3201 ((string-match (car rep) string)
3202 (setq string
3203 (mapconcat (lambda(x)
3204 (if (symbolp x)
3205 (symbol-value x)
3206 (replace-match x t nil string)))
3207 (cdr rep) ""))))))
3208 string)
3209
3210 (defconst preview-LaTeX-disable-pdfoutput
3211 '(("\\`\\(pdf[^ ]*\\)\
3212 \\(\\( [-&]\\([^ \"]\\|\"[^\"]*\"\\)*\\|\
3213 \"[-&][^\"]*\"\\)*\\)\\(.*\\)\\'"
3214 . ("\\1\\2 \"\\\\pdfoutput=0 \" \\5")))
3215 "This replacement places `\"\\pdfoutput=0 \"' after the options
3216 of any command starting with `pdf'.")
3217
3218 (defcustom preview-LaTeX-command-replacements
3219 nil
3220 "Replacement for `preview-LaTeX-command'.
3221 This is passed through `preview-do-replacements'."
3222 :group 'preview-latex
3223 :type '(repeat
3224 (choice
3225 (symbol :tag "Named replacement" :value preview-LaTeX-disable-pdfoutput)
3226 (cons (string :tag "Matched string")
3227 (repeat :tag "Concatenated elements for replacement"
3228 (choice (symbol :tag "Variable with literal string")
3229 (string :tag "non-literal regexp replacement")))))))
3230
3231 (defvar preview-format-name)
3232
3233 (defcustom preview-dump-replacements
3234 '(preview-LaTeX-command-replacements
3235 ("\\`\\([^ ]+\\)\
3236 \\(\\( +-\\([^ \\\\\"]\\|\\\\\\.\\|\"[^\"]*\"\\)*\\)*\\)\\(.*\\)\\'"
3237 . ("\\1 -ini -interaction=nonstopmode \"&\\1\" " preview-format-name ".ini \\5")))
3238 "Generate a dump command from the usual preview command."
3239 :group 'preview-latex
3240 :type '(repeat
3241 (choice (symbol :tag "Named replacement")
3242 (cons string (repeat (choice symbol string))))))
3243
3244 (defcustom preview-undump-replacements
3245 '(("\\`\\([^ ]+\\)\
3246 .*? \"\\\\input\" \\(.*\\)\\'"
3247 . ("\\1 -interaction=nonstopmode \"&" preview-format-name "\" \\2")))
3248 "Use a dumped format for reading preamble."
3249 :group 'preview-latex
3250 :type '(repeat
3251 (choice (symbol :tag "Named replacement")
3252 (cons string (repeat (choice symbol string))))))
3253
3254
3255 (defun preview-cache-preamble (&optional format-cons)
3256 "Dump a pregenerated format file.
3257 For the rest of the session, this file is used when running
3258 on the same master file.
3259
3260 Returns the process for dumping, nil if there is still a valid
3261 format available.
3262
3263 If FORMAT-CONS is non-nil, a previous format may get reused."
3264 (interactive)
3265 (let* ((dump-file
3266 (expand-file-name (preview-dump-file-name (TeX-master-file "ini"))))
3267 (master (TeX-master-file))
3268 (format-name (expand-file-name master))
3269 (preview-format-name (shell-quote-argument
3270 (preview-dump-file-name (file-name-nondirectory
3271 master))))
3272 (master-file (expand-file-name (TeX-master-file t)))
3273 (command (preview-do-replacements
3274 (TeX-command-expand
3275 (preview-string-expand preview-LaTeX-command)
3276 'TeX-master-file)
3277 preview-dump-replacements))
3278 (preview-auto-cache-preamble nil))
3279 (unless (and (consp (cdr format-cons))
3280 (string= command (cadr format-cons)))
3281 (unless format-cons
3282 (setq format-cons (assoc format-name preview-dumped-alist)))
3283 (if format-cons
3284 (preview-cache-preamble-off format-cons)
3285 (setq format-cons (list format-name))
3286 (push format-cons preview-dumped-alist))
3287 ;; mylatex.ltx expects a file name to follow. Bad. `.tex'
3288 ;; in the tools bundle is an empty file.
3289 (write-region "\\ifx\\pdfoutput\\undefined\\else\
3290 \\let\\PREVIEWdump\\dump\\def\\dump{%
3291 \\edef\\next{{\\catcode`\\ 9 \\pdfoutput=\\the\\pdfoutput\\relax\
3292 \\the\\everyjob}}\\everyjob\\next\\catcode`\\ 10 \\let\\dump\\PREVIEWdump\\dump}\\fi\\input mylatex.ltx \\relax\n" nil dump-file)
3293 (TeX-save-document master)
3294 (prog1
3295 (preview-generate-preview
3296 nil (file-name-nondirectory master)
3297 command)
3298 (add-hook 'kill-emacs-hook #'preview-cleanout-tempfiles t)
3299 (setq TeX-sentinel-function
3300 `(lambda (process string)
3301 (condition-case err
3302 (progn
3303 (if (and (eq (process-status process) 'exit)
3304 (zerop (process-exit-status process)))
3305 (preview-watch-preamble
3306 ',master-file
3307 ',command
3308 ',format-cons)
3309 (preview-format-kill ',format-cons))
3310 (delete-file ',dump-file))
3311 (error (preview-log-error err "Dumping" process)))
3312 (preview-reraise-error process)))))))
3313
3314 (defun preview-cache-preamble-off (&optional old-format)
3315 "Clear the pregenerated format file.
3316 The use of the format file is discontinued.
3317 OLD-FORMAT may already contain a format-cons as
3318 stored in `preview-dumped-alist'."
3319 (interactive)
3320 (unless old-format
3321 (setq old-format
3322 (let ((master-file (expand-file-name (TeX-master-file))))
3323 (or (assoc master-file preview-dumped-alist)
3324 (car (push (list master-file) preview-dumped-alist))))))
3325 (preview-unwatch-preamble old-format)
3326 (preview-format-kill old-format)
3327 (setcdr old-format nil))
3328
3329 (defun preview-region (begin end)
3330 "Run preview on region between BEGIN and END."
3331 (interactive "r")
3332 (TeX-region-create (TeX-region-file TeX-default-extension)
3333 (buffer-substring begin end)
3334 (if buffer-file-name
3335 (file-name-nondirectory buffer-file-name)
3336 "<none>")
3337 (save-restriction
3338 (widen)
3339 (let ((inhibit-point-motion-hooks t)
3340 (inhibit-field-text-motion t))
3341 (+ (count-lines (point-min) begin)
3342 (save-excursion
3343 (goto-char begin)
3344 (if (bolp) 0 -1))))))
3345 (preview-generate-preview t (TeX-region-file nil t)
3346 (preview-do-replacements
3347 (TeX-command-expand
3348 (preview-string-expand preview-LaTeX-command)
3349 'TeX-region-file)
3350 preview-LaTeX-command-replacements)))
3351
3352 (defun preview-buffer ()
3353 "Run preview on current buffer."
3354 (interactive)
3355 (preview-region (point-min) (point-max)))
3356
3357 ;; We have a big problem: When we are dumping preambles, diagnostics
3358 ;; issued in later runs will not make it to the output when the
3359 ;; predumped format skips the preamble. So we have to place those
3360 ;; after \begin{document}. This we can only do if regions never
3361 ;; include the preamble. We could do this in our own functions, but
3362 ;; that would not extend to the operation of C-c C-r g RET. So we
3363 ;; make this preamble skipping business part of TeX-region-create.
3364 ;; This will fail if the region is to contain just part of the
3365 ;; preamble -- a bad idea anyhow.
3366
3367 (defadvice TeX-region-create (before preview-preamble preactivate activate)
3368 "Skip preamble for the sake of predumped formats."
3369 (when (string-match TeX-header-end (ad-get-arg 1))
3370 (ad-set-arg 1
3371 (prog1 (substring (ad-get-arg 1) (match-end 0))
3372 (ad-set-arg 3
3373 (with-temp-buffer
3374 (insert (substring (ad-get-arg 1)
3375 0 (match-end 0)))
3376 (+ (ad-get-arg 3)
3377 (count-lines (point-min) (point-max))
3378 (if (bolp) 0 -1))))))))
3379
3380 (defun preview-document ()
3381 "Run preview on master document."
3382 (interactive)
3383 (TeX-save-document (TeX-master-file))
3384 (preview-generate-preview
3385 nil (TeX-master-file nil t)
3386 (preview-do-replacements
3387 (TeX-command-expand
3388 (preview-string-expand preview-LaTeX-command)
3389 'TeX-master-file)
3390 preview-LaTeX-command-replacements)))
3391
3392 (defun preview-environment (count)
3393 "Run preview on LaTeX environment.
3394 This avoids running environments through preview that are
3395 indicated in `preview-inner-environments'. If you use a prefix
3396 argument COUNT, the corresponding level of outward nested
3397 environments is selected."
3398 (interactive "p")
3399 (save-excursion
3400 (let (currenv)
3401 (dotimes (i (1- count))
3402 (setq currenv (LaTeX-current-environment))
3403 (if (string= currenv "document")
3404 (error "No enclosing outer environment found"))
3405 (LaTeX-find-matching-begin))
3406 (while (member (setq currenv (LaTeX-current-environment))
3407 preview-inner-environments)
3408 (LaTeX-find-matching-begin))
3409 (if (string= currenv "document")
3410 (error "No enclosing outer environment found"))
3411 (preview-region
3412 (save-excursion (LaTeX-find-matching-begin) (point))
3413 (save-excursion (LaTeX-find-matching-end) (point))))))
3414
3415 (defun preview-section ()
3416 "Run preview on LaTeX section." (interactive)
3417 (save-excursion
3418 (LaTeX-mark-section)
3419 (preview-region (region-beginning) (region-end))))
3420
3421
3422 (defun preview-generate-preview (region-p file command)
3423 "Generate a preview.
3424 REGION-P is the region flag, FILE the file (without default
3425 extension and directory), COMMAND is the command to use.
3426
3427 It returns the started process."
3428 (setq TeX-current-process-region-p region-p)
3429 (let* ((geometry (preview-get-geometry))
3430 (commandbuff (current-buffer))
3431 (pr-file (cons
3432 (if TeX-current-process-region-p
3433 'TeX-region-file
3434 'TeX-master-file)
3435 file))
3436 (master (TeX-master-file))
3437 (master-file (expand-file-name master))
3438 (dumped-cons (assoc master-file
3439 preview-dumped-alist))
3440 process)
3441 (unless dumped-cons
3442 (push (setq dumped-cons (cons master-file
3443 (if (eq preview-auto-cache-preamble 'ask)
3444 (y-or-n-p "Cache preamble? ")
3445 preview-auto-cache-preamble)))
3446 preview-dumped-alist))
3447 (when (cdr dumped-cons)
3448 (let* (TeX-current-process-region-p)
3449 (setq process (preview-cache-preamble dumped-cons))
3450 (if process
3451 (setq TeX-sentinel-function
3452 `(lambda (process string)
3453 (funcall ,TeX-sentinel-function process string)
3454 (TeX-inline-preview-internal
3455 ,command ,file
3456 ',pr-file ,commandbuff
3457 ',dumped-cons
3458 ',master
3459 ',geometry
3460 (buffer-string)))))))
3461 (or process
3462 (TeX-inline-preview-internal command file
3463 pr-file commandbuff
3464 dumped-cons master
3465 geometry))))
3466
3467 (defun TeX-inline-preview-internal (command file pr-file
3468 commandbuff dumped-cons master
3469 geometry
3470 &optional str)
3471 "Internal stuff for previewing.
3472 COMMAND and FILE should be explained in `TeX-command-list'.
3473 PR-FILE is the target file name in the form for `preview-gs-file'.
3474 COMMANDBUFF, DUMPED-CONS, MASTER, and GEOMETRY are
3475 internal parameters, STR may be a log to insert into the current log."
3476 (set-buffer commandbuff)
3477 (let*
3478 ((preview-format-name (shell-quote-argument
3479 (preview-dump-file-name
3480 (file-name-nondirectory master))))
3481 (process
3482 (TeX-run-command
3483 "Preview-LaTeX"
3484 (if (consp (cdr dumped-cons))
3485 (preview-do-replacements
3486 command preview-undump-replacements)
3487 command) file)))
3488 (condition-case err
3489 (progn
3490 (when str
3491 (save-excursion
3492 (goto-char (point-min))
3493 (insert str)
3494 (when (= (process-mark process) (point-min))
3495 (set-marker (process-mark process) (point)))))
3496 (preview-set-geometry geometry)
3497 (setq preview-gs-file pr-file)
3498 (setq TeX-sentinel-function 'preview-TeX-inline-sentinel)
3499 (when (featurep 'mule)
3500 (setq preview-coding-system
3501 (or (and (boundp 'TeX-japanese-process-output-coding-system)
3502 TeX-japanese-process-output-coding-system)
3503 (with-current-buffer commandbuff
3504 buffer-file-coding-system)))
3505 (when preview-coding-system
3506 (setq preview-coding-system
3507 (preview-buffer-recode-system
3508 (coding-system-base preview-coding-system))))
3509 (set-process-coding-system
3510 process preview-coding-system))
3511 (TeX-parse-reset)
3512 (setq TeX-parse-function 'TeX-parse-TeX)
3513 (if TeX-process-asynchronous
3514 process
3515 (TeX-synchronous-sentinel "Preview-LaTeX" file process)))
3516 (error (preview-log-error err "Preview" process)
3517 (delete-process process)
3518 (preview-reraise-error process)))))
3519
3520 (defconst preview-version (eval-when-compile
3521 (let ((name "$Name: release_11_87 $")
3522 (rev "$Revision: 1.286 $"))
3523 (or (when (string-match "\\`[$]Name: *release_\\([^ ]+\\) *[$]\\'" name)
3524 (setq name (match-string 1 name))
3525 (while (string-match "_" name)
3526 (setq name (replace-match "." t t name)))
3527 name)
3528 (if (string-match "\\`[$]Revision: *\\([^ ]+\\) *[$]\\'" rev)
3529 (format "CVS-%s" (match-string 1 rev)))
3530 "unknown")))
3531 "Preview version.
3532 If not a regular release, CVS revision of `preview.el'.")
3533
3534 (defconst preview-release-date
3535 (eval-when-compile
3536 (let ((date "$Date: 2011/01/23 18:53:55 $"))
3537 (string-match
3538 "\\`[$]Date: *\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)"
3539 date)
3540 (format "%s.%s%s" (match-string 1 date) (match-string 2 date)
3541 (match-string 3 date))))
3542 "Preview release date.
3543 In the form of yyyy.mmdd")
3544
3545 (defun preview-dump-state (buffer)
3546 (condition-case nil
3547 (progn
3548 (unless (local-variable-p 'TeX-command-buffer)
3549 (setq buffer (with-current-buffer buffer (TeX-active-buffer))))
3550 (when (bufferp buffer)
3551 (insert "\nRun buffer contents:\n\n")
3552 (if (< (buffer-size buffer) 5000)
3553 (insert-buffer-substring buffer)
3554 (insert-buffer-substring buffer 1 2500)
3555 (insert "...\n\n[...]\n\n\t...")
3556 (insert-buffer-substring buffer
3557 (- (buffer-size buffer) 2500)
3558 (buffer-size buffer)))
3559 (insert "\n")))
3560 (error nil)))
3561
3562 ;;;###autoload
3563 (defun preview-report-bug () "Report a bug in the preview-latex package."
3564 (interactive)
3565 (let ((reporter-prompt-for-summary-p "Bug report subject: "))
3566 (reporter-submit-bug-report
3567 "bug-auctex@gnu.org"
3568 (if (string-match "^CVS-" preview-version)
3569 (concat "preview-" (substring preview-version 4))
3570 preview-version)
3571 '(AUCTeX-version
3572 LaTeX-command-style
3573 image-types
3574 preview-image-type
3575 preview-image-creators
3576 preview-dvipng-image-type
3577 preview-dvipng-command
3578 preview-pdf2dsc-command
3579 preview-gs-command
3580 preview-gs-options
3581 preview-gs-image-type-alist
3582 preview-fast-conversion
3583 preview-prefer-TeX-bb
3584 preview-dvips-command
3585 preview-fast-dvips-command
3586 preview-scale-function
3587 preview-LaTeX-command
3588 preview-required-option-list
3589 preview-preserve-counters
3590 preview-default-option-list
3591 preview-default-preamble
3592 preview-LaTeX-command-replacements
3593 preview-dump-replacements
3594 preview-undump-replacements
3595 preview-auto-cache-preamble
3596 preview-TeX-style-dir)
3597 `(lambda () (preview-dump-state ,(current-buffer)))
3598 (lambda ()
3599 (insert (format "\nOutput from running `%s -h':\n"
3600 preview-gs-command))
3601 (call-process preview-gs-command nil t nil "-h")
3602 (insert "\n"))
3603 "Remember to cover the basics. Including a minimal LaTeX example
3604 file exhibiting the problem might help."
3605 )))
3606
3607 (eval-when-compile
3608 (when (boundp 'preview-compatibility-macros)
3609 (dolist (elt preview-compatibility-macros)
3610 (if (consp elt)
3611 (fset (car elt) (cdr elt))
3612 (fmakunbound elt)))))
3613
3614 (makunbound 'preview-compatibility-macros)
3615
3616 (provide 'preview)
3617 ;;; preview.el ends here