← Back to branch summary

~ubuntu-branches/ubuntu/saucy/texmacs/saucy-proposed

« back to all changes in this revision

Viewing changes to TeXmacs/progs/convert/images/tmimage.scm

  • Committer: Package Import Robot
  • Author(s): Atsuhito KOHDA
  • Date: 2013-02-21 11:51:59 UTC
  • mfrom: (4.3.2 sid)
  • Revision ID: package-import@ubuntu.com-20130221115159-e0ejzow5o83ogzsy
Tags: 1:1.0.7.18-1
* New Upstream Release.
* Removed 05_fixRd.patch and updated 01_american.patch, 09_ipa.patch
  10_tex-files.cpp.patch

Show diffs side-by-side

added added

removed removed

Lines of Context:
TeXmacs/progs/convert/images/tmimage.scm
26
26
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
27
27
 
28
28
(define-preferences
29
 
  ("texmacs->graphics:tmml" "off" noop)
30
 
  ("texmacs->graphics:attr" "on" noop)
31
29
  ("texmacs->graphics:format" "svg" noop))
32
30
 
33
31
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
39
37
(define (url-temp-ext ext)
40
38
  (url-glue (url-temp) (string-append "." ext)))
41
39
 
 
40
;; new system function call that check that output is produced
 
41
;; and give minimum information if not
 
42
 
 
43
(define no-error-yet #t)
 
44
 
 
45
(define (system-2-check cmd urlin urlout)
 
46
;; this fails for convert on windows XP, but why??  (system-2 cmd urlin urlout)
 
47
;; very uggly workaround:
 
48
(if (and (or (os-win32?) (os-mingw?)) (string=? (string-take cmd 7) "convert"))
 
49
    (system (string-append cmd " \""(url-concretize urlin)"\" \""
 
50
                           (url-concretize urlout) "\"" ))
 
51
    (system-2 cmd urlin urlout))
 
52
(if (and (not (url-exists? urlout)) no-error-yet)
 
53
    (begin
 
54
      (set-message (string-append cmd " failed") "Check converters")
 
55
      (display (string-append "image conversion problem: " cmd " failed\n" ))
 
56
      (display "check converter setup, existence in path...\n" )
 
57
      (set! no-error-yet #f))
 
58
))
 
59
;; since we chain converters
 
60
;; the first error will trigger a cascade of failures
 
61
;; so we only report the first error in export-selection-as-graphics.
 
62
;; We display error both in console and in status bar for console-less
 
63
 
 
64
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
65
;; external converters
 
66
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
67
 
 
68
;; In windows, passing correctly arguments to
 
69
;; the gs tools and pdf2svg is a serious issue in some cases.
 
70
;; In particular, in XP filenames may have spaces and/or accents
 
71
;; (eg in french localized TEXMACS_HOME_PATH : "Données d'applications")
 
72
;; that cause them to fail. I deliver the only workaround I could find:
 
73
;; We provide customized versions of gs tools which
 
74
;; work by converting pathes to old MSDOS-style ascii-only shortened version.
 
75
;; Note that these short names may be deactived in some NT-based systems,
 
76
;; which would break our workaround.
 
77
;; The custom .bat gs tools go in /bin with texmacs.exe and gsw32c.exe
 
78
;; We also need to provide pdf2svg.exe and the needed dlls.
 
79
;; The standard install of imagemagick on windows puts it in the path
 
80
;; so not much to do
 
81
 
 
82
(cond ((or (os-win32?) (os-mingw?))
 
83
       (define win-tm-path (system->url "$TEXMACS_PATH"))
 
84
       (define ps2eps
 
85
         (string-append
 
86
          "\""
 
87
          (url-concretize
 
88
           (url-append win-tm-path
 
89
                       (string->url "bin/tm-ps2epsi.bat"))) "\""))
 
90
       (define ps2pdf
 
91
         (string-append
 
92
          "\""
 
93
          (url-concretize
 
94
           (url-append win-tm-path
 
95
                       (string->url "bin/tm-ps2pdf.bat")))"\""))
 
96
       (define pdf2svg
 
97
         (string-append
 
98
          "\""
 
99
          (url-concretize
 
100
           (url-append win-tm-path
 
101
                       (string->url "bin/tm-pdf2svg.bat")))"\""))
 
102
       )
 
103
 
 
104
      (else ;; MacOS and Linux
 
105
        (define ps2eps "ps2epsi")
 
106
        (define ps2pdf "ps2pdf -dEPSCrop")
 
107
        (define pdf2svg "pdf2svg")
 
108
 
 
109
        (if (not (url-exists-in-path? "pdf2svg"))
 
110
            (begin
 
111
              (set-message "warning: pdf2svg not in path"
 
112
                           "svg export not available")
 
113
              (display
 
114
               "Texmacs] Warning: pdf2svg not in path; svg export not available\n" )
 
115
              )))
 
116
 
 
117
;;we just assume gs (including ps2epsi, ps2pdf) is available in *nix ans MacOS
 
118
      )
 
119
 
 
120
;; on all OSes check for "convert"
 
121
;; also check for "conjure" because windows systems may have an homonym
 
122
(if (not (and (url-exists-in-path? "convert") (url-exists-in-path? "conjure")))
 
123
    (begin
 
124
      (set-message "warning: ImageMagick not in path"
 
125
                   "bitmap export not available")
 
126
      (display
 
127
       "Texmacs] Warning: ImageMagick not in path; bitmap export not available\n" )
 
128
      ))
 
129
 
 
130
 
42
131
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
43
132
;; commodity functions for tree manipulations
44
133
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
50
139
(define (move-node! node parent-dest pos)
51
140
  ;; moves an existing node (with children if any) and
52
141
  ;; insert it as new child of parent-dest
53
 
  ;; FIXME: No sanity check! parent should not be in node's subtree! 
 
142
  ;; FIXME: No sanity check! parent should not be in node's subtree!
54
143
  (tree-insert! parent-dest pos `(,node))
55
144
  (remove-node! node))
56
145
 
61
150
 
62
151
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
63
152
;; 2 functions for remapping cross-referenced items (glyphs)
64
 
;; in the svg using unique ids this is needed to avoid collisions between
 
153
;; in the svg using unique ids. This is needed to avoid collisions between
65
154
;; definitions belonging to differents formulas in inkscape
66
155
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
67
156
 
68
 
(define (newids! lablist seed-string) 
 
157
(define (newids! lablist tm-fragment-string)
69
158
  ;; replaces all ids in the svg
70
159
  ;; plus returns an associationlist for mapping old id to new ones
71
 
  ;; we will use it to replace hyperlinks to the former ids to the new ones 
72
 
  (let* ((unique (number->string (random 1000000 (seed->random-state
73
 
                                                  seed-string))))
74
 
         ;; generate a reproducible 6-digit number that depends 
75
 
         ;; on the tm-code of the selection
 
160
  ;; we will use it to replace hyperlinks to the former ids to the new ones
 
161
  (let* ((unique (number->string (string-hash tm-fragment-string 1000000)))
 
162
         ;; generate a reproducible 6-digit number that depends
 
163
         ;; on the tm code of the selection
76
164
         (basename (string-append "tm" unique "-"))
77
165
         (newalist '())
78
166
         (n (length lablist)))
79
 
    (do ((i 0 (+ i 1))) ((= i n)) 
 
167
    (do ((i 0 (+ i 1))) ((= i n))
80
168
      (let* ((newlabel (string-append basename (number->string i)))
81
169
             (labelnode (list-ref lablist i))
82
170
             (oldlabel (tree->string labelnode)))
83
171
        (set! newalist (assoc-set! newalist (string-append "#" oldlabel)
84
 
                                   (string-append "#" newlabel) )) 
 
172
                                   (string-append "#" newlabel) ))
85
173
        (replace-leaftext! labelnode newlabel)))
86
174
    newalist))
87
175
 
88
176
(define (replace-hlinks! hreflist alist)
89
177
  ;; use the above association list to actualy replace
90
178
  ;; the xlink:href items with updated targets
91
 
  (map (lambda (leaf) 
 
179
  (map (lambda (leaf)
92
180
         (let ((newtarget (assoc-ref alist (tree->string leaf))))
93
181
           (replace-leaftext! leaf newtarget)))
94
182
       hreflist))
96
184
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
97
185
;; define latex and texmacs string representation of selection
98
186
;; we escape them to ascii so that they do not interfere with xml
99
 
;; <  -> &lt;  > -> &gt; \ -> \\, all characters above #127->\xXX ... 
 
187
;; <  -> &lt;  > -> &gt; \ -> \\, all characters above #127->\xXX ...
100
188
;; see  TeXmacs/langs/encodings/cork-escaped-to-ascii.scm
101
189
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
102
190
 
103
 
(define (latex-encode tm-fragment-tree) 
 
191
(define (latex-encode tm-fragment-tree)
104
192
  ;; for the latex representation we mimick what is done when
105
 
  ;; "copy to latex" is performed 
 
193
  ;; "copy to latex" is performed
106
194
  (let* ((latex-tree (latex-expand tm-fragment-tree))
107
195
         ;; expand or not macros according to preferences
108
196
         (latex-code (texmacs->generic latex-tree "latex-snippet")))
109
197
         ;; actual conversion
110
198
    (escape-to-ascii latex-code)))
111
 
 
112
 
(define (tm-encode tm-fragment-tree) 
 
199
 
 
200
(define (tm-encode tm-fragment-tree)
113
201
  (escape-to-ascii (serialize-texmacs tm-fragment-tree)))
114
202
 
115
203
(define (refactor-svg dest tm-fragment)
117
205
  ;; equation. dest is the url of the svg file to be edited
118
206
  ;; A latex fragment is also added for compatibility with
119
207
  ;; 'textext' inkscape extension
120
 
  ;; FIXME : no error checking, no return value... 
121
 
  ;; FIXME if the selection contains a postscript figure
122
 
  ;; it seems not escaped correctly.
123
 
  ;; TODO/FIXME : choose what embedding format is preferred for
124
 
  ;; native tm data, it is pointless to have both.
125
 
  ;; presently 
126
 
  ;; - the re-edition mechanism favors the attribute if both
127
 
  ;;   are present (latex is always last choice).
128
 
  ;; - the attribute method works best because tmml format is
129
 
  ;;   *broken both on export and import* (and should be fixed IMHO).
130
 
  ;; But tmml seems more natural to include in svg, and gives more room
 
208
  ;; FIXME : no error checking, no return value...
131
209
  ;; for improvements (we could pass the style that was used when
132
210
  ;; the equation was created, the fonts,...)
133
211
 
134
212
 
135
 
  (let* 
 
213
  (let*
136
214
      (;; first: load svg and transform to an active tree in
137
 
       ;; temporary buffer so that we can manipulate it 
 
215
       ;; temporary buffer so that we can manipulate it
138
216
       ;; using texmacs primitives for trees
139
217
       (svg-in (string-load dest)) ;; load svg file as string
140
218
       (s-svg-in (parse-xml svg-in)) ;; parse to stree
142
220
       ;; create temporary buffer for subsequent manipulations of svg tree
143
221
       (void (buffer-set-body mybuf (tree-assign-node! (stree->tree s-svg-in)
144
222
                                                       'concat)))
145
 
       ;; populate buffer with tree 
 
223
       ;; populate buffer with tree
146
224
       ;; replace *TOP* node by concat otherwise displaying
147
225
       ;; that buffer crashes texmacs
148
226
 
149
227
       ;; second: define a bunch of locations in the tree
150
228
       (buftree (buffer-get-body mybuf)) ;; the whole tree
151
 
       (svgroot (car (select buftree '(:* svg)))) ;; the <svg > node 
 
229
       (svgroot (car (select buftree '(:* svg)))) ;; the <svg > node
152
230
       (maingroup (car (select svgroot '(g))))
153
231
       ;; the main group in the svg, containing the drawing layout
154
232
       (maingroup-attrib (car (select maingroup '(@))))
163
241
 
164
242
       ;; third: the new data we want to insert in the tree
165
243
       (latex-code (latex-encode tm-fragment))
166
 
       (tm-code (tm-encode tm-fragment)) 
 
244
       (tm-code (tm-encode tm-fragment))
167
245
       ;; define new attributes containing latex and texmacs code:
168
246
       (extra-latex-attrib
169
 
        `((xmlns:ns0 "http://www.iki.fi/pav/software/textext/") 
170
 
          (ns0:text ,latex-code) (ns0:preamble "texmacs_latex.sty"))) 
171
 
       (extra-tm-attrib `((xmlns:ns1 "http://www.texmacs.org/") 
 
247
        `((xmlns:ns0 "http://www.iki.fi/pav/software/textext/")
 
248
          (ns0:text ,latex-code) (ns0:preamble "texmacs_latex.sty")))
 
249
       (extra-tm-attrib `((xmlns:ns1 "http://www.texmacs.org/")
172
250
                          (ns1:texmacscode ,tm-code)))
173
251
       ;; OK, the texmacs namespace maybe not correctly described at that url
174
 
       ;; as an alternative to inserting the tm-code as attribute string,
175
 
       ;; we can embbed it as xml in the svg :
176
 
       (tmml-fragment
177
 
        `((desc (@ (id "texmacs"))
178
 
                (TeXmacs (@ (xmlns "http://www.texmacs.org/")
179
 
                            (version ,(texmacs-version-release "")))
180
 
                         (tm-par ,(tmtmml (tree->stree tm-fragment)))))))
181
252
       (old->new-labels (newids! idlist tm-code))
182
253
       ;; rename all ids, create an association list of old to new ids
183
254
       )
184
 
    
 
255
 
185
256
    ;; fourth: modify tree
186
257
    (replace-hlinks! hreflist old->new-labels)
187
258
    ;; replace hlinks with new pointers
188
259
    (tree-insert! maingroup-attrib 1 extra-latex-attrib)
189
260
    ;; for textext compatibility
190
 
    (if (== "on" (get-preference "texmacs->graphics:attr"))
191
 
        (tree-insert! maingroup-attrib 2 extra-tm-attrib))
192
 
    (move-node! defs maingroup 3)
 
261
    (tree-insert! maingroup-attrib 2 extra-tm-attrib)
 
262
    (move-node! defs maingroup 2)
193
263
    ;; move defs containing the glyph outlines inside main group
194
264
    ;; so that they remain together in inkscape
195
 
    (if (== "on" (get-preference "texmacs->graphics:tmml"))
196
 
        (tree-insert! maingroup 4 tmml-fragment)) 
197
 
  
 
265
 
198
266
    ;; Fifth : finally create output
199
267
    (let* (;; convert back to stree, recreate the *TOP* node,
200
 
           ;; and restore *PI* xml 
 
268
           ;; and restore *PI* xml
201
269
           ;; (instead of *PI* "xml" given by tree->stree -
202
270
           ;; otherwise serialize-html fails)
203
271
           (s-svg-out
205
273
                    ;; actually we use only ascii
206
274
                    (cddr (tree->stree buftree))))
207
275
           (xml-svg-out (begin (output-flush) ;; necessary??
208
 
                               (serialize-tmml s-svg-out)))) 
 
276
                               (serialize-tmml s-svg-out))))
209
277
      ;; close temporary buffer
210
278
      (buffer-pretend-saved mybuf)
211
279
      (buffer-close mybuf)
220
288
  (:argument void "not used")
221
289
  (:returns "nothing")
222
290
  ;;the format of the graphics is set in the preferences
223
 
  (if (not (qt-gui?)) 
 
291
  (if (not (qt-gui?))
224
292
    (set-message "Qt GUI only, sorry. Use \"Export selection...\"" "")
225
293
    (if (not (selection-active-any?))
226
294
      (set-message "no selection!" "")
230
298
        ;; first generate an image file
231
299
        (graphics-file-to-clipboard tmpurl)
232
300
        ;; place that image on the clipboard
233
 
        ;;(system-remove tmpurl)
 
301
        (system-remove tmpurl)
234
302
        ))))
235
303
 
236
304
(tm-define (export-selection-as-graphics myurl)
237
305
  (:synopsis "Generates graphics format of the current selection")
238
306
  (:argument myurl "A full file url with extension")
239
307
  (:returns "nothing")
240
 
  ;; FIXME : no error checking, no retun value... 
241
 
  ;; FIXME : external tools calls are not OS independent presently
242
 
  ;; no check is performed on presence of the required conversion tools
243
308
  ;; global document parameters such as style, fonts, etc. are respected
244
309
  ;; in the typesetting. However they are presently not passed to
245
310
  ;; the svg and therefore lost when re-editing the svg
250
315
             ;;if selection is part of math need to re-encapsulate
251
316
             ;; it with math to obtain proper typesetting :
252
317
             (tm-fragment
253
 
              (if (tree-multi-paragraph? (selection-tree)) 
254
 
                  (selection-tree) 
 
318
              (if (tree-multi-paragraph? (selection-tree))
 
319
                  (selection-tree)
255
320
                  (if (in-math?)
256
321
                      (stree->tree `(equation* (document ,(selection-tree))))
257
322
                      (selection-tree))))
261
326
             (tm-fragment-enforce-pagewidth
262
327
              (stree->tree
263
328
               `(tabular
264
 
                 (tformat (twith "table-width" "1par") 
265
 
                          (twith "table-hmode" "exact") 
 
329
                 (tformat (twith "table-width" "1par")
 
330
                          (twith "table-hmode" "exact")
266
331
                          (cwith "1" "1" "1" "1" "cell-hyphen" "t")
267
332
                          (table (row (cell (document ,tm-fragment))))))))
268
333
             (temp0 (url-temp-ext "ps"))
269
334
             (temp1 (url-temp-ext "eps"))
270
335
             (dpi-pref (get-preference "printer dpi"))
271
336
             (suffix (url-suffix myurl)))
272
 
        
273
 
        (set-printer-dpi "236") ; 472 is ~ exact size 
 
337
 
 
338
        (set! no-error-yet #t)
 
339
        (set-printer-dpi "236") ; 472 is ~ exact size
274
340
        ;;set to a fixed value so our graphics does
275
341
        ;;not depend on the printer dpi
276
342
        ;;We need to set this weird dpi value so that the size of the svg
279
345
        ;;typeset fragment to ps as starting point
280
346
        (set-printer-dpi dpi-pref)
281
347
        ;; revert to preference dpi
282
 
        (system-2 "ps2epsi" temp0 temp1)
 
348
        (system-2-check ps2eps temp0 temp1)
283
349
        ;;make eps to get optimized bounding box. We could generate
284
350
        ;; directly the eps, but then the bounding box width
285
 
        ;; is a full pagewidth 
 
351
        ;; is a full pagewidth
286
352
        (system-remove temp0)
287
353
        ;; step 2 generate output according to desired output format
288
 
        
 
354
 
289
355
        (cond ((== suffix "eps")
290
356
               (system-copy temp1 myurl))
291
357
              ((== suffix "pdf")
292
 
               (system-2 "ps2pdf -dEPSCrop" temp1 myurl)
293
 
               (system-remove temp1))
294
 
              ((== suffix "svg")  
 
358
               (system-2-check ps2pdf temp1 myurl))
 
359
              ((== suffix "svg")
295
360
               ;; assume target is inkscape with texmacs.ink plugin
296
361
               ;; allowing to re-edit the original tm selection
297
 
               ;; (presumably an equation) 
 
362
               ;; (presumably an equation)
298
363
               (let* ((temp2 (url-temp-ext "pdf")))
299
 
                 ;; still need pdf as intermediate format                 
300
 
                 (system-2 "ps2pdf -dEPSCrop" temp1 temp2) 
301
 
                 (system-2 "pdf2svg" temp2 myurl) 
 
364
                 ;; still need pdf as intermediate format
 
365
                 (system-2-check ps2pdf temp1 temp2)
 
366
                 (system-2-check pdf2svg temp2 myurl)
302
367
                 ;; chaining these 2 specific converters is crucial
303
368
                 ;; for svg inport in inkscape:
304
369
                 ;; fonts are properly passed as vector outlines
305
370
                 (refactor-svg myurl tm-fragment)
306
371
                 ;; modify svg, embedding texmacs code
307
 
                 ;; (system-remove temp2)
 
372
                 (system-remove temp2)
308
373
                 ))
309
374
              (else
310
375
                ;; other formats : use imagemagick generic converter
311
 
                ;; this is where png, jpg, etc is generated  
 
376
                ;; this is where png, jpg, etc is generated
312
377
                ;; we ask imagemagick to insert texmacs source
313
378
                ;; in image metadata (comment)
314
 
                (system-2
315
 
                 (string-append "convert -density 300 -comment \"" 
 
379
                (system-2-check
 
380
                 (string-append "convert -density 300 -comment \""
316
381
                                (tm-encode tm-fragment) "\"")
317
382
                 temp1 myurl)))
318
 
        
 
383
 
319
384
        (system-remove temp1) ;; temp eps file not needed anymore
320
385
        )))