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