-
-
Notifications
You must be signed in to change notification settings - Fork 5
/
Copy pathpreview.el
4408 lines (4091 loc) · 183 KB
/
preview.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; preview.el --- embed preview LaTeX images in source buffer -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2024 Free Software Foundation, Inc.
;; Author: David Kastrup
;; Keywords: tex, text, convenience
;; This file is part of AUCTeX.
;; AUCTeX is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by the
;; Free Software Foundation; either version 3, or (at your option) any
;; later version.
;; AUCTeX is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
;; for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This style is for the "seamless" embedding of generated images
;; into LaTeX source code. Please see the README and INSTALL files
;; for further instruction.
;;
;; Please use the usual configure script for installation: more than
;; just Elisp files are involved: a LaTeX style, icon files, startup
;; code and so on.
;;
;; Quite a few things with regard to preview-latex's operation can be
;; configured by using
;; M-x customize-group RET preview RET
;;
;; Please report bugs with M-x preview-report-bug RET.
;;; Code:
(require 'auctex)
(require 'tex)
(require 'latex)
(eval-when-compile
(condition-case nil
(require 'desktop)
(file-error (message "Missing desktop package:
preview-latex buffers will not survive across sessions.")))
(condition-case nil
(require 'reporter)
(file-error (message "Missing reporter library, probably from the mail-lib package:
preview-latex's bug reporting commands will probably not work.")))
(require 'info))
(defgroup preview nil "Embed Preview images into LaTeX buffers."
:group 'AUCTeX
:prefix "preview-"
:link '(custom-manual "(preview-latex)Top")
:link '(info-link "(preview-latex)The Emacs interface")
:link '(url-link :tag "Homepage" "https://www.gnu.org/software/auctex/"))
(defgroup preview-gs nil "Preview's Ghostscript renderer."
:group 'preview
:prefix "preview-")
(defgroup preview-appearance nil "Preview image appearance."
:group 'preview
:prefix "preview-")
(defconst preview-specs-type
'(repeat
(list :tag "Image spec"
;; Use an extra :value keyword to avoid a bug in
;; `widget-convert' of XEmacs 21.4 and Emacs 21.
;; Analogously for the following `const' statements.
(const :format "" :value :type)
(choice :tag "Image type"
(const xpm)
(const xbm)
(symbol :tag "Other"))
(set :inline t :tag "Minimum font size"
(list :inline t :tag ""
(const :format "" :value :min)
(integer :tag "pixels")))
(const :format "" :value :file) (string :tag "Filename")
(set :inline t :tag "Ascent ratio"
(list :inline t :tag ""
(const :format "" :value :ascent)
(integer :tag "percent of image"
:value 50))))))
(defun preview-specs-setter (symbol value)
"Set SYMBOL to VALUE and clear `preview-min-alist' property.
This is used in icon specs, so that customizing will
clear cached icons."
(put symbol 'preview-min-alist nil)
(set-default symbol value))
(defcustom preview-nonready-icon-specs
'((:type xpm :min 26 :file "prvwrk24.xpm" :ascent 90)
(:type xpm :min 22 :file "prvwrk20.xpm" :ascent 90)
(:type xpm :min 17 :file "prvwrk16.xpm" :ascent 90)
(:type xpm :min 15 :file "prvwrk14.xpm" :ascent 90)
(:type xpm :file "prvwrk12.xpm" :ascent 90)
(:type xbm :file "prvwrk24.xbm" :ascent 90))
"The icon used for previews to be generated.
The spec must begin with `:type'. File names are relative to
`load-path' and `data-directory', a spec `:min' requires a
minimal pixel height for `preview-reference-face' before the spec
will be considered. Since evaluating the `:file' spec takes
considerable time under XEmacs, it should come after the `:min'
spec to avoid unnecessary evaluation time."
:group 'preview-appearance
:type preview-specs-type
:set #'preview-specs-setter)
(defvar preview-nonready-icon nil
"The icon used for previews to be generated.
Suitable spec is chosen from `preview-nonready-icon-specs'.")
(defcustom preview-error-icon-specs
'((:type xpm :min 22 :file "prverr24.xpm" :ascent 90)
(:type xpm :min 18 :file "prverr20.xpm" :ascent 90)
(:type xpm :file "prverr16.xpm" :ascent 90)
(:type xbm :file "prverr24.xbm" :ascent 90))
"The icon used for PostScript errors.
The spec must begin with `:type'. File names are relative to
`load-path' and `data-directory', a spec `:min' requires a
minimal pixel height for `preview-reference-face' before the spec
will be considered. Since evaluating the `:file' spec takes
considerable time under XEmacs, it should come after the `:min'
spec to avoid unnecessary evaluation time."
:group 'preview-appearance
:type preview-specs-type
:set #'preview-specs-setter
)
(defvar preview-error-icon nil
"The icon used for PostScript errors.
Suitable spec is chosen from `preview-error-icon-specs'.")
(defcustom preview-icon-specs
'((:type xpm :min 24 :file "prvtex24.xpm" :ascent 75)
(:type xpm :min 20 :file "prvtex20.xpm" :ascent 75)
(:type xpm :min 16 :file "prvtex16.xpm" :ascent 75)
(:type xpm :file "prvtex12.xpm" :ascent 75)
(:type xbm :min 24 :file "prvtex24.xbm" :ascent 75)
(:type xbm :min 16 :file "prvtex16.xbm" :ascent 75)
(:type xbm :file "prvtex12.xbm" :ascent 75))
"The icon used for an open preview.
The spec must begin with `:type'. File names are relative to
`load-path' and `data-directory', a spec `:min' requires a
minimal pixel height for `preview-reference-face' before the spec
will be considered. Since evaluating the `:file' spec takes
considerable time under XEmacs, it should come after the `:min'
spec to avoid unnecessary evaluation time."
:group 'preview-appearance
:type preview-specs-type
:set #'preview-specs-setter)
(defvar preview-icon nil
"The icon used for an open preview.
Suitable spec is chosen from `preview-icon-specs'.")
(defgroup preview-latex nil "LaTeX options for preview."
:group 'preview
:prefix "preview-")
(defcustom preview-image-creators
'((dvipng
(open preview-gs-open preview-dvipng-process-setup)
(place preview-gs-place)
(close preview-dvipng-close))
(png (open preview-gs-open)
(place preview-gs-place)
(close preview-gs-close))
(jpeg (open preview-gs-open)
(place preview-gs-place)
(close preview-gs-close))
(pnm (open preview-gs-open)
(place preview-gs-place)
(close preview-gs-close))
(tiff (open preview-gs-open)
(place preview-gs-place)
(close preview-gs-close)))
"Define functions for generating images.
These functions get called in the process of generating inline
images of the specified type. The open function is called
at the start of a rendering pass, the place function for
placing every image, the close function at the end of
the pass. Look at the documentation of the various
functions used here for the default settings, and at
the function `preview-call-hook' through which those are
called. Additional argument lists specified in here
are passed to the functions before any additional
arguments given to `preview-call-hook'.
Not all of these image types may be supported by your copy
of Ghostscript, or by your copy of Emacs."
:group 'preview-gs
:type '(alist :key-type (symbol :tag "Preview's image type")
:value-type
(alist :tag "Handler" :key-type (symbol :tag "Operation:")
:value-type (list :tag "Handler"
(function :tag "Handler function")
(repeat :tag "Additional \
function args" :inline t sexp))
:options (open place close))))
(defcustom preview-gs-image-type-alist
'((png png "-sDEVICE=png16m")
(dvipng png "-sDEVICE=png16m")
(jpeg jpeg "-sDEVICE=jpeg")
(pnm pbm "-sDEVICE=pnmraw")
(tiff tiff "-sDEVICE=tiff12nc"))
"Alist of image types and corresponding Ghostscript options.
The `dvipng' and `postscript' (don't use) entries really specify
a fallback device when images can't be processed by the requested
method, like when PDFTeX was used."
:group 'preview-gs
:type '(repeat (list :tag nil (symbol :tag "preview image-type")
(symbol :tag "Emacs image-type")
(repeat :inline t :tag "Ghostscript options" string))))
(defcustom preview-image-type 'png
"Image type to be used in images."
:group 'preview-gs
:type (append '(choice)
(mapcar (lambda (symbol) (list 'const (car symbol)))
preview-image-creators)
'((symbol :tag "Other"))))
(defun preview-call-hook (symbol &rest rest)
"Call a function from `preview-image-creators'.
This looks up SYMBOL in the `preview-image-creators' entry
for the image type `preview-image-type' and calls the
hook function given there with the arguments specified there
followed by REST. If such a function is specified in there,
that is."
(let ((hook (cdr (assq symbol
(cdr (assq preview-image-type
preview-image-creators))))))
(when hook
(apply (car hook) (append (cdr hook) rest)))))
(defvar-local TeX-active-tempdir nil
"List of directory name, top directory name and reference count.")
(defcustom preview-bb-filesize 1024
"Size of file area scanned for bounding box information."
:group 'preview-gs :type 'integer)
(defcustom preview-preserve-indentation t
"Whether to keep additional whitespace at the left of a line."
:group 'preview-appearance :type 'boolean)
(defun preview-extract-bb (filename)
"Extract EPS bounding box vector from FILENAME."
(with-temp-buffer
(insert-file-contents-literally filename nil 0 preview-bb-filesize
t)
(goto-char (point-min))
(when (search-forward-regexp "%%BoundingBox:\
+\\([-+]?[0-9.]+\\)\
+\\([-+]?[0-9.]+\\)\
+\\([-+]?[0-9.]+\\)\
+\\([-+]?[0-9.]+\\)" nil t)
(vector
(if preview-preserve-indentation
(min 72 (string-to-number (match-string 1)))
(string-to-number (match-string 1)))
(string-to-number (match-string 2))
(string-to-number (match-string 3))
(string-to-number (match-string 4))
))))
(defcustom preview-prefer-TeX-bb nil
"Prefer TeX bounding box to EPS one if available.
If `preview-fast-conversion' is set, this option is not
consulted since the TeX bounding box has to be used anyway."
:group 'preview-gs
:type 'boolean)
(defcustom preview-TeX-bb-border 0.5
"Additional space in pt around Bounding Box from TeX."
:group 'preview-gs
:type 'number)
(defvar-local preview-parsed-font-size nil
"Font size as parsed from the log of LaTeX run.")
(defvar-local preview-parsed-magnification nil
"Magnification as parsed from the log of LaTeX run.")
(defvar-local preview-parsed-pdfoutput nil
"PDFoutput as parsed from the log of LaTeX run.")
(defvar-local preview-parsed-counters nil
"Counters as parsed from the log of LaTeX run.")
(defvar-local preview-parsed-tightpage nil
"Tightpage as parsed from the log of LaTeX run.")
(defun preview-get-magnification ()
"Get magnification from `preview-parsed-magnification'."
(if preview-parsed-magnification
(/ preview-parsed-magnification 1000.0) 1.0))
(defun preview-TeX-bb (list)
"Calculate bounding box from (ht dp wd).
LIST consists of TeX dimensions in sp (1/65536 TeX point)."
(and
(consp list)
(let* ((dims (vconcat (mapcar
#'(lambda (x)
(/ x 65781.76))
list)))
(box
(vector
(+ 72 (min 0 (aref dims 2)))
(+ 720 (min (aref dims 0) (- (aref dims 1)) 0))
(+ 72 (max 0 (aref dims 2)))
(+ 720 (max (aref dims 0) (- (aref dims 1)) 0))))
(border (if preview-parsed-tightpage
(vconcat (mapcar
#'(lambda(x)
(/ x 65781.76))
preview-parsed-tightpage))
(vector (- preview-TeX-bb-border)
(- preview-TeX-bb-border)
preview-TeX-bb-border
preview-TeX-bb-border))))
(dotimes (i 4)
(aset box i (+ (aref box i) (aref border i))))
box)))
(defcustom preview-gs-command
(or ;; The GS wrapper coming with TeX Live
(executable-find "rungs")
;; The MikTeX builtin GS
(let ((gs (executable-find "mgs")))
;; Check if mgs is functional for external non-MikTeX apps.
;; See http://blog.miktex.org/post/2005/04/07/Starting-mgsexe-at-the-DOS-Prompt.aspx
(when (and gs (= 0 (shell-command (concat (shell-quote-argument gs) " -q -dNODISPLAY -c quit"))))
gs))
;; Windows ghostscript
(executable-find "GSWIN32C.EXE")
;; standard GhostScript
(executable-find "gs"))
"How to call gs for conversion from EPS. See also `preview-gs-options'."
:group 'preview-gs
:type 'string)
(defcustom preview-gs-options '("-q" "-dDELAYSAFER" "-dNOPAUSE"
"-DNOPLATFONTS" "-dPrinted"
"-dTextAlphaBits=4"
"-dGraphicsAlphaBits=4")
"Options with which to call gs for conversion from EPS.
See also `preview-gs-command'."
:group 'preview-gs
:type '(repeat string))
(defvar-local preview-gs-queue nil
"List of overlays to convert using gs.
Buffer-local to the appropriate TeX process buffer.")
(defvar-local preview-gs-outstanding nil
"Overlays currently processed.")
(defcustom preview-gs-outstanding-limit 2
"Number of requests allowed to be outstanding.
This is the number of not-yet-completed requests we
might at any time have piped into Ghostscript. If
this number is larger, the probability of Ghostscript
working continuously is higher when Emacs is rather
busy. If this number is smaller, redisplay will
follow changes in the displayed buffer area faster."
:group 'preview-gs
:type '(restricted-sexp
:match-alternatives
((lambda (value) (and
(integerp value)
(> value 0)
(< value 10))))
:tag "small number"))
(defvar-local preview-gs-answer nil
"Accumulated answer of Ghostscript process.")
(defvar-local preview-gs-image-type nil
"Image type for gs produced images.")
(defvar-local preview-gs-sequence nil
"Pair of sequence numbers for gs produced images.")
(defvar-local preview-scale nil
"Screen scale of images.
Magnify by this factor to make images blend with other
screen content. Buffer-local to rendering buffer.")
(defvar-local preview-colors nil
"Color setup list.
An array with elements 0, 1 and 2 for background,
foreground and border colors, respectively. Each element
is a list of 3 real numbers between 0 and 1, or nil
of nothing special should be done for the color")
(defvar-local preview-gs-init-string nil
"Ghostscript setup string.")
(defvar-local preview-ps-file nil
"PostScript file name for fast conversion.")
(defvar-local preview-gs-dsc nil
"Parsed DSC information.")
(defvar-local preview-resolution nil
"Screen resolution where rendering started.
Cons-cell of x and y resolution, given in
dots per inch. Buffer-local to rendering buffer.")
(defun preview-gs-resolution (scale xres yres)
"Generate resolution argument for gs.
Calculated from real-life factor SCALE and XRES and
YRES, the screen resolution in dpi."
(format "-r%gx%g"
(/ (* scale xres) (preview-get-magnification))
(/ (* scale yres) (preview-get-magnification))))
(defun preview-gs-behead-outstanding (err)
"Remove leading element of outstanding queue after error.
Return element if non-nil. ERR is the error string to
show as response of Ghostscript."
(let ((ov (pop preview-gs-outstanding)))
(when ov
(preview-gs-flag-error ov err)
(overlay-put ov 'queued nil))
ov))
(defvar-local preview-gs-command-line nil)
(defvar-local preview-gs-file nil)
(defcustom preview-fast-conversion t
"Set this for single-file PostScript conversion.
This will have no effect when `preview-image-type' is
set to `postscript'."
:group 'preview-latex
:type 'boolean)
(defun preview-string-expand (arg &optional separator)
"Expand ARG as a string.
It can already be a string. Or it can be a list, then it is
recursively evaluated using SEPARATOR as separator. If a list
element is in itself a CONS cell, the CAR of the list (after symbol
dereferencing) can evaluate to either a string, in which case it is
used as a separator for the rest of the list,
or a boolean (t or nil) in which case the rest of the list is
either evaluated and concatenated or ignored, respectively.
ARG can be a symbol, and so can be the CDR
of a cell used for string concatenation."
(cond
((stringp arg) arg)
((consp arg)
(mapconcat
#'identity
(delq nil
(mapcar
(lambda(x)
(if (consp x)
(let ((sep (car x)))
(while (and (symbolp sep)
(not (memq sep '(t nil))))
(setq sep (symbol-value sep)))
(if (stringp sep)
(preview-string-expand (cdr x) sep)
(and sep
(preview-string-expand (cdr x)))))
(preview-string-expand x)))
arg))
(or separator "")))
((and (symbolp arg) (not (memq arg '(t nil))))
(preview-string-expand (symbol-value arg) separator))
(t (error "Bad string expansion"))))
(defconst preview-expandable-string
(let ((f (lambda (x)
`(choice
string
(repeat :tag "Concatenate"
(choice
string
(cons :tag "Separated list"
(choice (string :tag "Separator")
(symbol :tag
"Indirect separator or flag"))
,x)
(symbol :tag "Indirect variable (no separator)")))
(symbol :tag "Indirect variable (with separator)")))))
(funcall f (funcall f 'sexp)))
"Type to be used for `preview-string-expand'.
Just a hack until we get to learn how to do this properly.
Recursive definitions are not popular with Emacs,
so we define this type just two levels deep. This
kind of expandible string can either be just a string, or a
cons cell with a separator string in the CAR, and either
an explicit list of elements in the CDR, or a symbol to
be consulted recursively.")
(defcustom preview-dvipng-command
"dvipng -picky -noghostscript %d -o %m/prev%%03d.png"
"Command used for converting to separate PNG images.
You might specify options for converting to other image types,
but then you'll need to adapt `preview-dvipng-image-type'."
:group 'preview-latex
:type 'string)
(defcustom preview-dvipng-image-type
'png
"Image type that dvipng produces.
You'll need to change `preview-dvipng-command' too,
if you customize this."
:group 'preview-latex
:type '(choice (const png)
(const gif)
(symbol :tag "Other" :value png)))
(defcustom preview-dvips-command
"dvips -Pwww -i -E %d -o %m/preview.000"
"Command used for converting to separate EPS images."
:group 'preview-latex
:type 'string)
(defcustom preview-fast-dvips-command
"dvips -Pwww %d -o %m/preview.ps"
"Command used for converting to a single PS file."
:group 'preview-latex
:type 'string)
(defcustom preview-pdf2dsc-command
"pdf2dsc %(O?pdf) %m/preview.dsc"
"Command used for generating dsc from a PDF file."
:group 'preview-latex
:type 'string)
(defun preview-gs-queue-empty ()
"Kill off everything remaining in `preview-gs-queue'."
(mapc #'preview-delete preview-gs-outstanding)
(dolist (ov preview-gs-queue)
(if (overlay-get ov 'queued)
(preview-delete ov)))
(setq preview-gs-outstanding nil)
(setq preview-gs-queue nil))
(defvar preview-error-condition nil
"Last error raised and to be reported.")
(defun preview-log-error (err context &optional process)
"Log an error message to run buffer.
ERR is the caught error syndrome, CONTEXT is where it
occured, PROCESS is the process for which the run-buffer
is to be used."
(when (or (null process) (buffer-name (process-buffer process)))
(with-current-buffer (or (and process
(process-buffer process))
(current-buffer))
(save-excursion
(goto-char (or (and process
(process-buffer process)
(marker-buffer (process-mark process))
(process-mark process))
(point-max)))
(insert-before-markers
(format "%s: %s\n"
context (error-message-string err)))
(display-buffer (current-buffer)))))
(setq preview-error-condition err))
(defun preview-reraise-error (&optional process)
"Raise an error that has been logged.
Makes sure that PROCESS is removed from the \"Compilation\"
tag in the mode line."
(when preview-error-condition
(unwind-protect
(signal (car preview-error-condition) (cdr preview-error-condition))
(setq preview-error-condition nil
compilation-in-progress (delq process compilation-in-progress)))))
(defcustom preview-pdf-color-adjust-method t
"Method to adjust colors of images generated from PDF.
It is not consulted when the latex command produces DVI files.
The valid values are:
t: preview-latex transfers the foreground and background colors
of Emacs to the generated images. This option requires that
Ghostscript has working DELAYBIND feature, thus is invalid with
gs 9.27 (and possibly < 9.27).
`compatible': preview-latex uses another mothod to transfer
colors. This option is provided for compatibility with older gs.
See the below explanation for detail.
nil: no adjustment is done and \"black on white\" image is
generated regardless of Emacs color. This is provided for fallback for
gs 9.27 users with customized foreground color. See the below
explanation for detail.
When the latex command produces PDF rather than DVI and Emacs has
non-trivial foreground color, the traditional method (`compatible')
makes gs >= 9.27 to stop with error. Here, \"non-trivial foreground
color\" includes customized themes.
If you use such non-trivial foreground color and the version of
Ghostscript equals to 9.27, you have two options:
- Choose the value `compatible' and customize
`preview-reference-face' to have default (black) foreground
color. This makes the generated image almost non-readable on
dark background, so the next option would be your only choice in
that case.
- Choose the value nil, which forces plain \"black on white\"
appearance for the generated image. You can at least read what
are written in the image although they may not match with your
Emacs color well."
:group 'preview-appearance
:type '(choice
(const :tag "Adjust to Emacs color (gs > 9.27)" t)
(const :tag "Compatibility for gs =< 9.27" compatible)
(const :tag "No adjustment (B/W, for gs 9.27)" nil)))
(defun preview-gs-sentinel (process string)
"Sentinel function for rendering process.
Gets the default PROCESS and STRING arguments
and tries to restart Ghostscript if necessary."
(condition-case err
(let ((status (process-status process)))
(when (memq status '(exit signal))
(setq compilation-in-progress (delq process compilation-in-progress)))
(when (buffer-name (process-buffer process))
(with-current-buffer (process-buffer process)
(goto-char (point-max))
(insert-before-markers "\n" mode-name " " string)
(forward-char -1)
(insert " at "
(substring (current-time-string) 0 -5))
(forward-char 1)
(TeX-command-mode-line process)
(when (memq status '(exit signal))
;; process died.
;; Throw away culprit, go on.
(let* ((err (concat preview-gs-answer "\n"
(process-name process) " " string))
(ov (preview-gs-behead-outstanding err)))
(when (and (null ov) preview-gs-queue)
(save-excursion
(goto-char (if (marker-buffer (process-mark process))
(process-mark process)
(point-max)))
(insert-before-markers err)))
(delete-process process)
(if (or (null ov)
(eq status 'signal))
;; if process was killed explicitly by signal, or if nothing
;; was processed, we give up on the matter altogether.
(progn
(when preview-ps-file
(condition-case nil
(preview-delete-file preview-ps-file)
(file-error nil)))
(preview-gs-queue-empty))
;; restart only if we made progress since last call
(let (filenames)
(dolist (ov preview-gs-outstanding)
(setq filenames (overlay-get ov 'filenames))
(condition-case nil
(preview-delete-file (nth 1 filenames))
(file-error nil))
(setcdr filenames nil)))
(setq preview-gs-queue (nconc preview-gs-outstanding
preview-gs-queue))
(setq preview-gs-outstanding nil)
(preview-gs-restart)))))))
(error (preview-log-error err "Ghostscript" process)))
(preview-reraise-error process))
(defun preview-gs-filter (process string)
"Filter function for processing Ghostscript output.
Gets the usual PROCESS and STRING parameters, see
`set-process-filter' for a description."
(with-current-buffer (process-buffer process)
(setq preview-gs-answer (concat preview-gs-answer string))
(while (string-match "GS\\(<[0-9]+\\)?>" preview-gs-answer)
(let* ((pos (match-end 0))
(answer (substring preview-gs-answer 0 pos)))
(setq preview-gs-answer (substring preview-gs-answer pos))
(condition-case err
(preview-gs-transact process answer)
(error (preview-log-error err "Ghostscript filter" process))))))
(preview-reraise-error))
(defun preview-gs-restart ()
"Start a new Ghostscript conversion process."
(when preview-gs-queue
(if preview-gs-sequence
(setcar preview-gs-sequence (1+ (car preview-gs-sequence)))
(setq preview-gs-sequence (list 1)))
(setcdr preview-gs-sequence 1)
(let* ((process-connection-type nil)
(outfile (format "-sOutputFile=%s"
(file-relative-name
(format "%s/pr%d-%%d.%s"
(car TeX-active-tempdir)
(car preview-gs-sequence)
preview-gs-image-type))))
(process
(apply #'start-process
"Preview-Ghostscript"
(current-buffer)
preview-gs-command
outfile
preview-gs-command-line)))
(goto-char (point-max))
(insert-before-markers "Running `Preview-Ghostscript' with ``"
(mapconcat #'shell-quote-argument
(append
(list preview-gs-command
outfile)
preview-gs-command-line)
" ") "''\n")
(setq preview-gs-answer "")
(set-process-query-on-exit-flag process nil)
(set-process-sentinel process #'preview-gs-sentinel)
(set-process-filter process #'preview-gs-filter)
(process-send-string process preview-gs-init-string)
(setq mode-name "Preview-Ghostscript")
(push process compilation-in-progress)
(TeX-command-mode-line process)
(force-mode-line-update)
process)))
(defun preview-gs-open (&optional setup)
"Start a Ghostscript conversion pass.
SETUP may contain a parser setup function."
(let ((image-info (assq preview-image-type preview-gs-image-type-alist)))
(setq preview-gs-image-type (nth 1 image-info))
(setq preview-gs-sequence nil)
(setq preview-gs-command-line (append
preview-gs-options
(nthcdr 2 image-info))
preview-gs-init-string
(format "{DELAYSAFER{.setsafe}if}stopped pop\
/.preview-BP currentpagedevice/BeginPage get dup \
null eq{pop{pop}bind}if def\
<</BeginPage{currentpagedevice/PageSize get dup 0 get 1 ne exch 1 get 1 ne or\
{.preview-BP %s}{pop}ifelse}bind/PageSize[1 1]>>setpagedevice\
/preview-do{/.preview-ST[count 4 roll save]def dup length 0 eq\
{pop}{setpagedevice}{ifelse exec}\
stopped{handleerror quit}if \
.preview-ST aload pop restore}bind def "
(preview-gs-color-string
preview-colors
;; Compatibility for gs 9.27 with non-trivial
;; foreground color and dark background.
;; Suppress color adjustment with PDF backend
;; when `preview-pdf-color-adjust-method' is nil.
(and (not preview-pdf-color-adjust-method)
;; The switch `preview-parsed-pdfoutput' isn't
;; set before parsing the latex output, so use
;; heuristic here.
(with-current-buffer TeX-command-buffer
(and TeX-PDF-mode
(not (TeX-PDF-from-DVI))))))))
(preview-gs-queue-empty)
(preview-parse-messages (or setup #'preview-gs-dvips-process-setup))))
(defun preview-gs-color-value (value)
"Return string to be used as color value for an RGB component.
Conversion from Emacs color numbers (0 to 65535) in VALUE
to Ghostscript floats."
(format "%g" (/ value 65535.0)))
(defun preview-pdf-color-string (colors)
"Return a string that patches PDF foreground color to work properly."
(let ((fg (aref colors 1)))
(if fg
(cond ((eq preview-pdf-color-adjust-method t)
;; New code for gs > 9.27.
;; This assumes DELAYBIND feature, which is known to be
;; broken in gs 9.27 (and possibly, < 9.27).
;; <URL:https://lists.gnu.org/archive/html/auctex-devel/2019-07/msg00000.html>
;; DELAYBIND is sometimes mentioned in association with
;; security holes in the changelog of Ghostscript:
;; <URL:https://www.ghostscript.com/doc/9.27/History9.htm>
;; Thus we might have to be prepared for removal of this
;; feature in future Ghostscript.
(concat
"/initgraphics {
//initgraphics
/RG where {
pop "
(mapconcat #'preview-gs-color-value fg " ")
" 3 copy rg RG
} if
} bind def .bindnow "))
((eq preview-pdf-color-adjust-method 'compatible)
;; Traditional code for gs < 9.27.
(concat
"/GS_PDF_ProcSet GS_PDF_ProcSet dup maxlength dict copy dup begin\
/graphicsbeginpage{//graphicsbeginpage exec "
(mapconcat #'preview-gs-color-value fg " ")
" 3 copy rg RG}bind store end readonly store "))
(;; Do nothing otherwise.
t
"")))))
(defun preview-gs-color-string (colors &optional suppress-fgbg)
"Return a string setting up COLORS.
If optional argument SUPPRESS-FGBG is non-nil, behave as if FG/BG
colors were just the default value."
(let ((bg (and (not suppress-fgbg)
(aref colors 0)))
(fg (and (not suppress-fgbg)
(aref colors 1)))
(mask (aref colors 2))
(border (aref colors 3)))
(concat
(and (or (and mask border) (and bg (not fg)))
"gsave ")
(and bg
(concat
(mapconcat #'preview-gs-color-value bg " ")
" setrgbcolor clippath fill "))
(and mask border
(format "%s setrgbcolor false setstrokeadjust %g \
setlinewidth clippath strokepath \
matrix setmatrix true \
{2 index{newpath}if round exch round exch moveto pop false}\
{round exch round exch lineto}{curveto}{closepath}\
pathforall pop fill "
(mapconcat #'preview-gs-color-value mask " ")
(* 2 border)))
;; I hate antialiasing. Warp border to integral coordinates.
(and (or (and mask border) (and bg (not fg)))
"grestore ")
(and fg
(concat
(mapconcat #'preview-gs-color-value fg " ")
" setrgbcolor")))))
(defun preview-dvipng-color-string (colors res)
"Return color setup tokens for dvipng.
Makes a string of options suitable for passing to dvipng.
Pure borderless black-on-white will return an empty string."
(let
((bg (aref colors 0))
(fg (aref colors 1))
(mask (aref colors 2))
(border (aref colors 3)))
(concat
(and bg
(format "--bg \"rgb %s\" "
(mapconcat #'preview-gs-color-value bg " ")))
(and fg
(format "--fg \"rgb %s\" "
(mapconcat #'preview-gs-color-value fg " ")))
(and mask border
(format "--bd \"rgb %s\" "
(mapconcat #'preview-gs-color-value mask " ")))
(and border
(format "--bd %d" (max 1 (round (/ (* res border) 72.0))))))))
(defsubst preview-supports-image-type (imagetype)
"Check if IMAGETYPE is supported."
(image-type-available-p imagetype))
(defun preview-gs-dvips-process-setup ()
"Set up Dvips process for conversions via gs."
(unless (preview-supports-image-type preview-gs-image-type)
(error "preview-image-type setting '%s unsupported by this Emacs"
preview-gs-image-type))
(setq preview-gs-command-line (append
preview-gs-command-line
(list (preview-gs-resolution
(preview-hook-enquiry preview-scale)
(car preview-resolution)
(cdr preview-resolution)))))
(if preview-parsed-pdfoutput
(preview-pdf2dsc-process-setup)
(let ((process (preview-start-dvips preview-fast-conversion)))
(setq TeX-sentinel-function #'preview-gs-dvips-sentinel)
(list process (current-buffer) TeX-active-tempdir preview-ps-file
preview-gs-image-type))))
(defun preview-dvipng-process-setup ()
"Set up dvipng process for conversion."
(setq preview-gs-command-line (append
preview-gs-command-line
(list (preview-gs-resolution
(preview-hook-enquiry preview-scale)
(car preview-resolution)
(cdr preview-resolution)))))
(if preview-parsed-pdfoutput
(if (preview-supports-image-type preview-gs-image-type)
(preview-pdf2dsc-process-setup)
(error "preview-image-type setting '%s unsupported by this Emacs"
preview-gs-image-type))
(unless (preview-supports-image-type preview-dvipng-image-type)
(error "preview-dvipng-image-type setting '%s unsupported by this Emacs"
preview-dvipng-image-type))
(let ((process (preview-start-dvipng)))
(setq TeX-sentinel-function #'preview-dvipng-sentinel)
(list process (current-buffer) TeX-active-tempdir t
preview-dvipng-image-type))))
(defun preview-pdf2dsc-process-setup ()
(let ((process (preview-start-pdf2dsc)))
(setq TeX-sentinel-function #'preview-pdf2dsc-sentinel)
(list process (current-buffer) TeX-active-tempdir preview-ps-file
preview-gs-image-type)))
(defun preview-dvips-abort ()
"Abort a Dvips run."
(preview-gs-queue-empty)
(condition-case nil
(delete-file
(let ((gsfile preview-gs-file))
(with-current-buffer TeX-command-buffer
(funcall (car gsfile) "dvi" t))))
(file-error nil))
(when preview-ps-file
(condition-case nil
(preview-delete-file preview-ps-file)
(file-error nil)))
(setq TeX-sentinel-function nil))
(defalias 'preview-dvipng-abort #'preview-dvips-abort)
; "Abort a DviPNG run.")
(defun preview-gs-dvips-sentinel (process _command &optional gsstart)
"Sentinel function for indirect rendering DviPS process.
The usual PROCESS and COMMAND arguments for
`TeX-sentinel-function' apply. Starts gs if GSSTART is set."
(condition-case err
(let ((status (process-status process))
(gsfile preview-gs-file))
(cond ((eq status 'exit)
(delete-process process)
(setq TeX-sentinel-function nil)
(condition-case nil
(delete-file
(with-current-buffer TeX-command-buffer
(funcall (car gsfile) "dvi" t)))
(file-error nil))
(if preview-ps-file
(preview-prepare-fast-conversion))
(when gsstart
(if preview-gs-queue
(preview-gs-restart)
(when preview-ps-file
(condition-case nil
(preview-delete-file preview-ps-file)
(file-error nil))))))
((eq status 'signal)
(delete-process process)
(preview-dvips-abort))))
(error (preview-log-error err "DviPS sentinel" process)))
(preview-reraise-error process))
(defun preview-pdf2dsc-sentinel (process _command &optional gsstart)
"Sentinel function for indirect rendering PDF process.
The usual PROCESS and COMMAND arguments for
`TeX-sentinel-function' apply. Starts gs if GSSTART is set."
(condition-case err
(let ((status (process-status process)))
(cond ((eq status 'exit)
(delete-process process)
(setq TeX-sentinel-function nil)
;; Add DELAYBIND option for adjustment of foreground
;; color to work.
(if (and (eq preview-pdf-color-adjust-method t)
(aref preview-colors 1))
(setq preview-gs-command-line (append
preview-gs-command-line
'("-dDELAYBIND"))))
(setq preview-gs-init-string
(concat preview-gs-init-string
(preview-pdf-color-string preview-colors)))
(preview-prepare-fast-conversion)
(when gsstart
(if preview-gs-queue
(preview-gs-restart)
(when preview-ps-file
(condition-case nil