1
2;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3;;
4;; MODULE      : generic-menu.scm
5;; DESCRIPTION : default focus menu
6;; COPYRIGHT   : (C) 2010  Joris van der Hoeven
7;;
8;; This software falls under the GNU general public license version 3 or later.
9;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE
10;; in the root directory or <http://www.gnu.org/licenses/gpl-3.0.html>.
11;;
12;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13
14(texmacs-module (generic generic-menu)
15  (:use (utils edit variants)
16	(generic generic-edit)
17	(generic format-edit)
18	(generic format-geometry-edit)
19        (generic document-edit)
20        (source source-edit)))
21
22;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
23;; Focus predicates
24;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
25
26(tm-define (focus-has-variants? t)
27  (> (length (focus-variants-of t)) 1))
28
29(tm-define (focus-has-toggles? t)
30  (or (numbered-context? t)
31      (alternate-context? t)))
32
33(tm-define (focus-can-move? t)
34  #t)
35
36(tm-define (focus-can-insert-remove? t)
37  (and (or (structured-horizontal? t) (structured-vertical? t))
38       (cursor-inside? t)))
39
40(tm-define (focus-can-insert? t)
41  (< (tree-arity t) (tree-maximal-arity t)))
42
43(tm-define (focus-can-remove? t)
44  (> (tree-arity t) (tree-minimal-arity t)))
45
46(tm-define (focus-has-geometry? t)
47  #f)
48
49(tm-define (focus-has-preferences? t)
50  (and (tree-compound? t) (tree-label-extension? (tree-label t))))
51
52(tm-define (focus-has-preferences? t)
53  (:require (tree-in? t '(reference pageref hlink locus ornament)))
54  #t)
55
56(tm-define (focus-can-search? t)
57  #f)
58
59;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
60;; Variants
61;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
62
63(tm-define (focus-variants-of t)
64  (variants-of (tree-label t)))
65
66(tm-define (focus-tag-name l)
67  (if (symbol-unnumbered? l)
68      (focus-tag-name (symbol-drop-right l 1))
69      (with r (upcase-first (tree-name (tree l)))
70        (string-replace r "-" " "))))
71
72(tm-menu (focus-variant-menu t)
73  (for (v (focus-variants-of t))
74    ((eval (focus-tag-name v))
75     (variant-set-keep-numbering (focus-tree) v))))
76
77;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
78;; Subroutines for hidden fields
79;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
80
81(tm-define (string-variable-name? t i)
82  (and (== (tree-child-type t i) "variable")
83       (tree-in? t '(with attr style-with style-with*))
84       (tree-atomic? (tree-ref t i))
85       (!= (tree->stree (tree-ref t i)) "")))
86
87(define (hidden-child? t i)
88  (and (not (tree-accessible-child? t i))
89       (not (string-variable-name? t i))
90       (!= (type->format (tree-child-type t i)) "n.a.")))
91
92(define (hidden-children t)
93  (with fun (lambda (i) (if (hidden-child? t i) (list (tree-ref t i)) (list)))
94    (append-map fun (.. 0 (tree-arity t)))))
95
96(define (tree-child-name* t i)
97  (with s (tree-child-name t i)
98    (cond ((!= s "") s)
99          ((and (> i 0) (string-variable-name? t (- i 1)))
100           (with r (tree->string (tree-ref t (- i 1)))
101             (string-replace r "-" " ")))
102          ((> (length (hidden-children t)) 1) "")
103          ((== (tree-child-type t i) "regular") "")
104          (else (tree-child-type t i)))))
105
106(define (tree-child-long-name* t i)
107  (with s (tree-child-long-name t i)
108    (cond ((!= s "") s)
109          ((and (> i 0) (string-variable-name? t (- i 1)))
110           (with r (tree->string (tree-ref t (- i 1)))
111             (string-replace r "-" " ")))
112          ((> (length (hidden-children t)) 1) "")
113          ((== (tree-child-type t i) "regular") "")
114          (else (tree-child-type t i)))))
115
116(define (type->format type)
117  (cond ((== type "adhoc") "n.a.")
118        ((== type "raw") "n.a.")
119        ((== type "url")
120         ;; FIXME: filename editing is way too slow in Qt and
121         ;; tab completion does not seem to work anyway
122         (if (qt-gui?) "string" "smart-file"))
123        ((== type "graphical") "n.a.")
124        ((== type "point") "n.a.")
125        ((== type "obsolete") "n.a.")
126        ((== type "unknown") "n.a.")
127        ((== type "error") "n.a.")
128        (else "string")))
129
130(define (type->width type)
131  (cond ((== type "boolean") "5em")
132        ((== type "integer") "5em")
133        ((== type "length") "5em")
134        ((== type "numeric") "5em")
135        ((== type "identifier") "8em")
136        ((== type "duration") "5em")
137        (else "1w")))
138
139(tm-define (inputter-active? t type)
140  (cond ((== type "length") (tm-rich-length? t))
141	(else (tree-atomic? t))))
142
143(tm-define (inputter-decode t type)
144  (cond ((== type "length") (tm->rich-length t))
145	(else (tree->string t))))
146
147(tm-define (inputter-encode s type)
148  (cond ((== type "length") (rich-length->tm s))
149	(else s)))
150
151(tm-menu (string-input-icon t i)
152  (let* ((name (tree-child-name* t i))
153         (type (tree-child-type t i))
154         (s (string-append (upcase-first name) ":"))
155         (active? (inputter-active? (tree-ref t i) type))
156	 (in (if active? (inputter-decode (tree-ref t i) type) "n.a."))
157         (in* (if active? in ""))
158         (fm (type->format type))
159         (w (type->width type))
160         (setter (lambda (x)
161		   (when x
162                     (tree-set (focus-tree) i (inputter-encode x type))))))
163    (assuming (== name "")
164      //)
165    (assuming (!= name "")
166      (glue #f #f 3 0)
167      (mini #t (group (eval s))))
168    (if (!= type "color")
169        (when active?
170          (mini #t
171            (input (setter answer) fm (list in) w))))
172    (if (== type "color")
173        (=> (color (tree->stree (tree-ref t i)) #f #f 24 16)
174            (pick-background "" (setter answer))
175            ---
176            ("Palette" (interactive-color setter '()))
177            ("Other" (interactive setter
178                       (list (upcase-first name) "color" in*)))))))
179
180(tm-menu (string-input-menu t i)
181  (let* ((name (tree-child-long-name* t i))
182         (s `(concat "Set " ,name))
183         (prompt (upcase-first name))
184         (type (tree-child-type t i))
185         (fm (type->format type))
186         (setter (lambda (x)
187		   (when x
188		     (tree-set (focus-tree) i (inputter-encode x type))))))
189    (assuming (!= name "")
190      (when (inputter-active? (tree-ref t i) type)
191        ((eval s)
192         (interactive setter
193	   (list prompt fm (inputter-decode (tree-ref t i) type))))))))
194
195(tm-menu (string-input-icon t i)
196  (:require (string-variable-name? t i))
197  (with c (tree-ref t i)
198    (with s (if (tree-atomic? c) (tree->string c) "n.a.")
199      (glue #f #f 3 0)
200      (mini #t (group (eval (string-append s ":")))))))
201
202;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
203;; Editing style parameters
204;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
205
206(tm-define (parameter-name l)
207  (focus-tag-name (string->symbol (tree-name (list (string->symbol l))))))
208
209(tm-menu (focus-parameter-menu-item l)
210  ((eval (parameter-name l)) (open-macro-editor l)))
211
212(tm-menu (init-env-menu l cs)
213  (with ss (list-filter cs string?)
214    ((check "Default" "*" (test-default? l))
215     (init-default l))
216    (if (nnull? ss)
217        ---
218        (for (c ss)
219          (if (string? c)
220              ((check (eval (upcase-first c)) "*" (test-init? l c))
221               (set-init-env l c)))))
222    (if (and (nnull? ss) (in? :other cs))
223        ---)
224    (if (in? :other cs)
225        ("Other" (init-interactive-env l)))))
226
227(tm-menu (focus-parameter-menu-item l)
228  (:require (and (tree-label-parameter? (string->symbol l))
229                 (string? (get-init-env l))
230                 (nin? (tree-label-type (string->symbol l))
231                       (list "unknown" "regular" "adhoc"))))
232  (-> (eval (focus-tag-name (string->symbol l)))
233      (dynamic (init-env-menu l (list :other)))))
234
235(tm-menu (focus-parameter-menu-item l)
236  (:require (and (tree-label-parameter? (string->symbol l))
237                 (string? (get-init-env l))
238                 (== (tree-label-type (string->symbol l)) "boolean")))
239  ((check (eval (focus-tag-name (string->symbol l))) "v"
240          (== (get-init-env l) "true"))
241   (toggle-init-env l)))
242
243(tm-menu (focus-parameter-menu-item l)
244  (:require (and (tree-label-parameter? (string->symbol l))
245                 (== (tree-label-type (string->symbol l)) "color")))
246  (-> (eval (focus-tag-name (string->symbol l)))
247      ((check "Default" "*" (test-default? l)) (init-default l))
248      ---
249      (pick-background "" (init-env-tree l answer))
250      ---
251      (if (in? l (list "locus-color" "visited-color"))
252          ((check "Preserve" "*" (test-init? l "preserve"))
253           (set-init-env l "preserve")))
254      ("Palette" (interactive-color (lambda (col) (init-env l col)) '()))
255      ("Other" (init-interactive-env l))))
256
257(tm-menu (focus-parameter-menu-item l)
258  (:require (parameter-choice-list l))
259  (with cs (parameter-choice-list l)
260    (-> (eval (focus-tag-name (string->symbol l)))
261        (dynamic (init-env-menu l cs)))))
262
263(tm-define (parameter-show-in-menu? l) #t)
264
265(tm-menu (focus-parameters-menu t)
266  (with ps (list-filter (search-tag-parameters t) parameter-show-in-menu?)
267    (if (nnull? ps)
268        (group "Style parameters")
269        (for (p ps)
270          (dynamic (focus-parameter-menu-item p)))
271        (if (tree-label-extension? (tree-label t))
272            ---))))
273
274(tm-define (parameter-show-in-menu? l)
275  (:require (in? l (list "the-label" "auto-nr" "current-part" "language"
276                         "page-nr" "page-the-page" "prog-language"
277			 "caption-summarized" "figure-width")))
278  #f)
279
280;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
281;; The main Focus menu
282;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
283
284;; FIXME: when recovering focus-tree,
285;; double check that focus-tree still has the required form
286
287(tm-menu (focus-ancestor-menu t))
288
289(tm-menu (focus-toggle-menu t)
290  (assuming (numbered-context? t)
291    ;; FIXME: itemize, enumerate, eqnarray*
292    ((check "Numbered" "v" (numbered-numbered? (focus-tree)))
293     (numbered-toggle (focus-tree))))
294  (assuming (alternate-context? t)
295    ((check (eval (alternate-second-name t)) "v"
296            (alternate-second? (focus-tree)))
297     (alternate-toggle (focus-tree))))
298  (assuming (!= (tree-children t) (tree-accessible-children t))
299    ((check "Show hidden" "v" (tree-is? t :up 'inactive))
300     (inactive-toggle t))))
301
302(tm-menu (focus-position-float-menu t))
303
304(tm-menu (focus-style-options-menu t)
305  (with opts (search-tag-options t)
306    (if (nnull? opts)
307        (group "Style options")
308        (for (opt opts)
309          ((check (balloon (eval (style-get-menu-name opt))
310                           (eval (style-get-documentation opt))) "v"
311                  (has-style-package? opt))
312           (toggle-style-package opt)))
313        (if (tree-label-extension? (tree-label t))
314            ---))))
315
316(tm-menu (focus-tag-edit-menu l)
317  (if (tree-label-extension? l)
318      (when (editable-macro? l)
319        ("Edit macro" (open-macro-editor l)))
320      (when (has-macro-source? l)
321        ("Edit source" (edit-macro-source l)))))
322
323(tm-menu (focus-preferences-menu t)
324  (dynamic (focus-style-options-menu t))
325  (dynamic (focus-parameters-menu t))
326  (dynamic (focus-tag-edit-menu (tree-label t))))
327
328(tm-menu (focus-tag-menu t)
329  (with l (focus-variants-of t)
330    (assuming (<= (length l) 1)
331      (inert ((eval (focus-tag-name (tree-label t))) (noop) (noop))))
332    (assuming (> (length l) 1)
333      (-> (eval (focus-tag-name (tree-label t)))
334          (dynamic (focus-variant-menu t)))))
335  (dynamic (focus-toggle-menu t))
336  (dynamic (focus-position-float-menu t))
337  (assuming (focus-has-preferences? t)
338    (-> "Preferences"
339        (dynamic (focus-preferences-menu t))))
340  ("Describe" (focus-help))
341  (assuming (focus-can-search? t)
342    ("Search in database" (focus-open-search-tool t)))
343  ("Delete" (remove-structure-upwards)))
344
345(tm-menu (focus-move-menu t)
346  ("Previous similar" (traverse-previous))
347  ("Next similar" (traverse-next))
348  ("First similar" (traverse-first))
349  ("Last similar" (traverse-last))
350  (assuming (cursor-inside? t)
351    ("Exit left" (structured-exit-left))
352    ("Exit right" (structured-exit-right))))
353
354(tm-menu (focus-insert-menu t)
355  (assuming (and (structured-horizontal? t) (not (structured-vertical? t)))
356    (when (focus-can-insert? t)
357      ("Insert argument before" (structured-insert-left))
358      ("Insert argument after" (structured-insert-right)))
359    (when (focus-can-remove? t)
360      ("Remove argument before" (structured-remove-left))
361      ("Remove argument after" (structured-remove-right))))
362  (assuming (structured-vertical? t)
363    ("Insert above" (structured-insert-up))
364    ("Insert left" (structured-insert-left))
365    ("Insert right" (structured-insert-right))
366    ("Insert below" (structured-insert-down))
367    ("Remove upwards" (structured-remove-up))
368    ("Remove leftwards" (structured-remove-left))
369    ("Remove rightwards" (structured-remove-right))
370    ("Remove downwards" (structured-remove-down))))
371
372(tm-menu (focus-extra-menu t))
373
374(tm-define (hidden-inputter-children t)
375  (append-map (lambda (c)
376		(if (and-with i (tree-index c)
377		      (with type (tree-child-type t i)
378			(inputter-active? c type)))
379		    (list c)
380		    (list)))
381              (hidden-children t)))
382
383(tm-menu (focus-hidden-menu t)
384  (assuming (nnull? (hidden-inputter-children t))
385    ---
386    (for (i (.. 0 (tree-arity t)))
387      (assuming (hidden-child? t i)
388        (dynamic (string-input-menu t i))))))
389
390(tm-menu (focus-hidden-menu t)
391  (:require (alternate-context? t)))
392
393(tm-menu (standard-focus-menu t)
394  (dynamic (focus-ancestor-menu t))
395  (dynamic (focus-tag-menu t))
396  (assuming (focus-can-move? t)
397    ---
398    (dynamic (focus-move-menu t)))
399  (assuming (focus-can-insert-remove? t)
400    ---
401    (dynamic (focus-insert-menu t)))
402  (dynamic (focus-extra-menu t))
403  (dynamic (focus-hidden-menu t)))
404
405(tm-menu (focus-menu)
406  (dynamic (standard-focus-menu (focus-tree))))
407
408;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
409;; The main focus icons bar
410;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
411
412(tm-menu (focus-ancestor-icons t))
413
414(tm-menu (focus-toggle-icons t)
415  (assuming (numbered-context? t)
416    ((check (balloon (icon "tm_numbered.xpm") "Toggle numbering") "v"
417            (numbered-numbered? (focus-tree)))
418     (numbered-toggle (focus-tree))))
419  (assuming (alternate-first? t)
420    ((check (balloon (icon "tm_alternate_first.xpm")
421                     (eval (alternate-second-name t))) "v" #f)
422     (alternate-toggle (focus-tree))))
423  (assuming (alternate-second? t)
424    ((check (balloon (icon (eval (alternate-second-icon t)))
425                     (eval (alternate-second-name t))) "v" #t)
426     (alternate-toggle (focus-tree))))
427  (assuming (!= (tree-children t) (tree-accessible-children t))
428    ((check (balloon (icon "tm_show_hidden.xpm") "Show hidden") "v"
429            (tree-is? t :up 'inactive))
430     (inactive-toggle t))))
431
432(tm-menu (focus-position-float-icons t))
433
434(tm-menu (focus-tag-extra-icons t))
435
436(tm-menu (focus-tag-icons t)
437  (dynamic (focus-toggle-icons t))
438  (dynamic (focus-position-float-icons t))
439  (mini #t
440    (with l (focus-variants-of t)
441      (assuming (<= (length l) 1)
442        (inert ((eval (focus-tag-name (tree-label t))) (noop))))
443      (assuming (> (length l) 1)
444        (=> (balloon (eval (focus-tag-name (tree-label t)))
445                     "Structured variant")
446            (dynamic (focus-variant-menu t))))))
447  (dynamic (focus-tag-extra-icons t))
448  (assuming (cursor-inside? t)
449    ((balloon (icon "tm_exit_left.xpm") "Exit tag on the left")
450     (structured-exit-left))
451    ((balloon (icon "tm_exit_right.xpm") "Exit tag on the right")
452     (structured-exit-right))
453    ((balloon (icon "tm_focus_delete.xpm") "Remove tag")
454     (remove-structure-upwards)))
455  (assuming (focus-has-preferences? t)
456    (=> (balloon (icon "tm_focus_prefs.xpm") "Preferences for tag")
457	(dynamic (focus-preferences-menu t))))
458  ((balloon (icon "tm_focus_help.xpm") "Describe tag")
459   (focus-help))
460  (assuming (focus-can-search? t)
461    ((balloon (icon "tm_focus_search.xpm") "Search in database")
462     (focus-open-search-tool t))))
463
464(tm-menu (focus-move-icons t)
465  ((balloon (icon "tm_similar_first.xpm") "Go to first similar tag")
466   (traverse-first))
467  ((balloon (icon "tm_similar_previous.xpm") "Go to previous similar tag")
468   (traverse-previous))
469  ((balloon (icon "tm_similar_next.xpm") "Go to next similar tag")
470   (traverse-next))
471  ((balloon (icon "tm_similar_last.xpm") "Go to last similar tag")
472   (traverse-last)))
473
474(tm-menu (focus-insert-icons t)
475  (assuming (and (structured-horizontal? t) (not (structured-vertical? t)))
476    (when (focus-can-insert? t)
477      ((balloon (icon "tm_insert_left.xpm") "Structured insert at the left")
478       (structured-insert-left))
479      ((balloon (icon "tm_insert_right.xpm") "Structured insert at the right")
480       (structured-insert-right)))
481    (when (focus-can-remove? t)
482      ((balloon (icon "tm_delete_left.xpm") "Structured remove leftwards")
483       (structured-remove-left))
484      ((balloon (icon "tm_delete_right.xpm") "Structured remove rightwards")
485       (structured-remove-right))))
486  (assuming (structured-vertical? t)
487    ((balloon (icon "tm_insert_up.xpm") "Structured insert above")
488     (structured-insert-up))
489    ((balloon (icon "tm_insert_left.xpm") "Structured insert at the left")
490     (structured-insert-left))
491    ((balloon (icon "tm_insert_right.xpm") "Structured insert at the right")
492     (structured-insert-right))
493    ((balloon (icon "tm_insert_down.xpm") "Structured insert below")
494     (structured-insert-down))
495    ((balloon (icon "tm_delete_up.xpm") "Structured remove upwards")
496     (structured-remove-up))
497    ((balloon (icon "tm_delete_left.xpm") "Structured remove leftwards")
498     (structured-remove-left))
499    ((balloon (icon "tm_delete_right.xpm") "Structured remove rightwards")
500     (structured-remove-right))
501    ((balloon (icon "tm_delete_down.xpm") "Structured remove downwards")
502     (structured-remove-down))))
503
504(tm-menu (focus-extra-icons t))
505
506(tm-menu (focus-hidden-icons t)
507  (for (i (.. 0 (tree-arity t)))
508    (assuming (hidden-child? t i)
509      (dynamic (string-input-icon t i)))))
510
511(tm-menu (focus-hidden-icons t)
512  (:require (alternate-context? t)))
513
514(tm-menu (standard-focus-icons t)
515  (dynamic (focus-ancestor-icons t))
516  (assuming (focus-can-move? t)
517    (minibar (dynamic (focus-move-icons t)))
518    //)
519  (assuming (focus-can-insert-remove? t)
520    (minibar (dynamic (focus-insert-icons t)))
521    //)
522  (minibar (dynamic (focus-tag-icons t)))
523  (dynamic (focus-extra-icons t))
524  (dynamic (focus-hidden-icons t))
525  //)
526
527(tm-menu (texmacs-focus-icons)
528  (assuming (in-graphics?)
529    (dynamic (graphics-focus-icons)))
530  (assuming (not (in-graphics?))
531    (dynamic (standard-focus-icons (focus-tree)))))
532
533;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
534;; Focus menus for customizable environments
535;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
536
537(tm-menu (focus-customizable-menu-item setter var name)
538  ((eval name) (interactive setter (list name "string" (get-env var)))))
539
540(tm-menu (focus-customizable-menu-item setter var name)
541  (:require (parameter-choice-list var))
542  (-> (eval name)
543      (for (val (parameter-choice-list var))
544        ((eval val) (setter val)))))
545
546(tm-menu (focus-customizable-menu-item setter var name)
547  (:require (== (tree-label-type (string->symbol var)) "color"))
548  (-> (eval name)
549      (pick-background "" (setter answer))
550      ---
551      ("Palette" (interactive-color setter '()))
552      ("Other" (interactive setter (list name "string" (get-env var))))))
553
554(tm-menu (focus-extra-menu t)
555  (:require (customizable-context? t))
556  ---
557  (for (p (customizable-parameters t))
558    (with (var name) p
559      (with l (tree-label t)
560        (with setter (lambda (val)
561                       (when (tree-is? (focus-tree) l)
562                         (tree-with-set (focus-tree) var val)))
563          (dynamic (focus-customizable-menu-item setter var name)))))))
564
565(tm-menu (focus-customizable-icons-item setter var name)
566  (input (setter answer) "string" (list (get-env var)) "5em"))
567
568(tm-menu (focus-customizable-icons-item setter var name)
569  (:require (parameter-choice-list var))
570  (mini #t
571    (=> (eval (get-env var))
572        (for (val (parameter-choice-list var))
573          ((eval val) (setter val))))))
574
575(tm-menu (focus-customizable-icons-item setter var name)
576  (:require (== (tree-label-type (string->symbol var)) "color"))
577  (=> (color (tree->stree (get-env-tree var)) #f #f 24 16)
578      (pick-background "" (setter answer))
579      ---
580      ("Palette" (interactive-color setter '()))
581      ("Other" (interactive setter (list name "string" (get-env var))))))
582
583(tm-menu (focus-extra-icons t)
584  (:require (customizable-context? t))
585  (for (p (customizable-parameters t))
586    (with (var name) p
587      (with l (tree-label t)
588        (with setter (lambda (val)
589                       (when (tree-is? (focus-tree) l)
590                         (tree-with-set (focus-tree) var val)))
591          (glue #f #f 3 0)
592          (mini #t (group (eval (string-append name ":"))))
593          (dynamic (focus-customizable-icons-item setter var name)))))))
594
595;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
596;; Immediately load document-menu
597;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
598
599(use-modules (generic document-menu))
600