"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "TeXmacs/progs/generic/generic-menu.scm" between
TeXmacs-1.99.4-src.tar.gz and TeXmacs-1.99.5-src.tar.gz

About: GNU TeXmacs is a what-you-see-is-what-you-get scientific text editor, which was both inspired by TeX and GNU Emacs.

generic-menu.scm  (TeXmacs-1.99.4-src):generic-menu.scm  (TeXmacs-1.99.5-src)
skipping to change at line 23 skipping to change at line 23
(texmacs-module (generic generic-menu) (texmacs-module (generic generic-menu)
(:use (utils edit variants) (:use (utils edit variants)
(generic generic-edit) (generic generic-edit)
(generic format-edit) (generic format-edit)
(generic format-geometry-edit) (generic format-geometry-edit)
(generic document-edit) (generic document-edit)
(source source-edit))) (source source-edit)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Focus predicates
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(tm-define (focus-has-variants? t)
(> (length (focus-variants-of t)) 1))
(tm-define (focus-has-toggles? t)
(or (numbered-context? t)
(alternate-context? t)))
(tm-define (focus-can-move? t)
#t)
(tm-define (focus-can-insert-remove? t)
(and (or (structured-horizontal? t) (structured-vertical? t))
(cursor-inside? t)))
(tm-define (focus-can-insert? t)
(< (tree-arity t) (tree-maximal-arity t)))
(tm-define (focus-can-remove? t)
(> (tree-arity t) (tree-minimal-arity t)))
(tm-define (focus-has-geometry? t)
#f)
(tm-define (focus-has-preferences? t)
(and (tree-compound? t) (tree-label-extension? (tree-label t))))
(tm-define (focus-has-preferences? t)
(:require (tree-in? t '(reference pageref hlink locus ornament)))
#t)
(tm-define (focus-can-search? t)
#f)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Variants ;; Variants
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(tm-define (focus-variants-of t) (tm-define (focus-variants-of t)
(variants-of (tree-label t))) (variants-of (tree-label t)))
(tm-define (focus-tag-name l) (tm-define (focus-tag-name l)
(if (symbol-unnumbered? l) (if (symbol-unnumbered? l)
(focus-tag-name (symbol-drop-right l 1)) (focus-tag-name (symbol-drop-right l 1))
(with r (upcase-first (tree-name (tree l))) (with r (upcase-first (tree-name (tree l)))
skipping to change at line 87 skipping to change at line 50
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Subroutines for hidden fields ;; Subroutines for hidden fields
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(tm-define (string-variable-name? t i) (tm-define (string-variable-name? t i)
(and (== (tree-child-type t i) "variable") (and (== (tree-child-type t i) "variable")
(tree-in? t '(with attr style-with style-with*)) (tree-in? t '(with attr style-with style-with*))
(tree-atomic? (tree-ref t i)) (tree-atomic? (tree-ref t i))
(!= (tree->stree (tree-ref t i)) ""))) (!= (tree->stree (tree-ref t i)) "")))
(define (hidden-child? t i) (tm-define (hidden-child? t i)
(and (not (tree-accessible-child? t i)) (and (not (tree-accessible-child? t i))
(not (string-variable-name? t i)) (not (string-variable-name? t i))
(!= (type->format (tree-child-type t i)) "n.a."))) (!= (type->format (tree-child-type t i)) "n.a.")))
(define (hidden-children t) (define (hidden-children t)
(with fun (lambda (i) (if (hidden-child? t i) (list (tree-ref t i)) (list))) (with fun (lambda (i) (if (hidden-child? t i) (list (tree-ref t i)) (list)))
(append-map fun (.. 0 (tree-arity t))))) (append-map fun (.. 0 (tree-arity t)))))
(define (tree-child-name* t i) (define (tree-child-name* t i)
(with s (tree-child-name t i) (with s (tree-child-name t i)
skipping to change at line 162 skipping to change at line 125
(let* ((name (tree-child-name* t i)) (let* ((name (tree-child-name* t i))
(type (tree-child-type t i)) (type (tree-child-type t i))
(s (string-append (upcase-first name) ":")) (s (string-append (upcase-first name) ":"))
(active? (inputter-active? (tree-ref t i) type)) (active? (inputter-active? (tree-ref t i) type))
(in (if active? (inputter-decode (tree-ref t i) type) "n.a.")) (in (if active? (inputter-decode (tree-ref t i) type) "n.a."))
(in* (if active? in "")) (in* (if active? in ""))
(fm (type->format type)) (fm (type->format type))
(w (type->width type)) (w (type->width type))
(setter (lambda (x) (setter (lambda (x)
(when x (when x
(tree-set (focus-tree) i (inputter-encode x type)))))) (tree-set (focus-tree) i (inputter-encode x type))
(focus-tree-modified (focus-tree))))))
(assuming (== name "") (assuming (== name "")
//) //)
(assuming (!= name "") (assuming (!= name "")
(glue #f #f 3 0) (glue #f #f 3 0)
(mini #t (group (eval s)))) (mini #t (group (eval s))))
(if (!= type "color") (if (!= type "color")
(when active? (when active?
(mini #t (mini #t
(input (setter answer) fm (list in) w)))) (input (setter answer) fm (list in) w))))
(if (== type "color") (if (== type "color")
skipping to change at line 188 skipping to change at line 152
(list (upcase-first name) "color" in*))))))) (list (upcase-first name) "color" in*)))))))
(tm-menu (string-input-menu t i) (tm-menu (string-input-menu t i)
(let* ((name (tree-child-long-name* t i)) (let* ((name (tree-child-long-name* t i))
(s `(concat "Set " ,name)) (s `(concat "Set " ,name))
(prompt (upcase-first name)) (prompt (upcase-first name))
(type (tree-child-type t i)) (type (tree-child-type t i))
(fm (type->format type)) (fm (type->format type))
(setter (lambda (x) (setter (lambda (x)
(when x (when x
(tree-set (focus-tree) i (inputter-encode x type)))))) (tree-set (focus-tree) i (inputter-encode x type))
(focus-tree-modified (focus-tree))))))
(assuming (!= name "") (assuming (!= name "")
(when (inputter-active? (tree-ref t i) type) (when (inputter-active? (tree-ref t i) type)
((eval s) ((eval s)
(interactive setter (interactive setter
(list prompt fm (inputter-decode (tree-ref t i) type)))))))) (list prompt fm (inputter-decode (tree-ref t i) type))))))))
(tm-menu (string-input-icon t i) (tm-menu (string-input-icon t i)
(:require (string-variable-name? t i)) (:require (string-variable-name? t i))
(with c (tree-ref t i) (with c (tree-ref t i)
(with s (if (tree-atomic? c) (tree->string c) "n.a.") (with s (if (tree-atomic? c) (tree->string c) "n.a.")
skipping to change at line 302 skipping to change at line 267
((check "Numbered" "v" (numbered-numbered? (focus-tree))) ((check "Numbered" "v" (numbered-numbered? (focus-tree)))
(numbered-toggle (focus-tree)))) (numbered-toggle (focus-tree))))
(assuming (alternate-context? t) (assuming (alternate-context? t)
((check (eval (alternate-second-name t)) "v" ((check (eval (alternate-second-name t)) "v"
(alternate-second? (focus-tree))) (alternate-second? (focus-tree)))
(alternate-toggle (focus-tree)))) (alternate-toggle (focus-tree))))
(assuming (!= (tree-children t) (tree-accessible-children t)) (assuming (!= (tree-children t) (tree-accessible-children t))
((check "Show hidden" "v" (tree-is? t :up 'inactive)) ((check "Show hidden" "v" (tree-is? t :up 'inactive))
(inactive-toggle t)))) (inactive-toggle t))))
(tm-menu (focus-position-float-menu t)) (tm-menu (focus-float-menu t))
(tm-menu (focus-animate-menu t))
(tm-menu (focus-misc-menu t))
(tm-menu (focus-style-options-menu t) (tm-menu (focus-style-options-menu t)
(with opts (search-tag-options t) (with opts (search-tag-options t)
(if (nnull? opts) (if (nnull? opts)
(group "Style options") (group "Style options")
(for (opt opts) (for (opt opts)
((check (balloon (eval (style-get-menu-name opt)) ((check (balloon (eval (style-get-menu-name opt))
(eval (style-get-documentation opt))) "v" (eval (style-get-documentation opt))) "v"
(has-style-package? opt)) (has-style-package? opt))
(toggle-style-package opt))) (toggle-style-package opt)))
skipping to change at line 336 skipping to change at line 303
(dynamic (focus-tag-edit-menu (tree-label t)))) (dynamic (focus-tag-edit-menu (tree-label t))))
(tm-menu (focus-tag-menu t) (tm-menu (focus-tag-menu t)
(with l (focus-variants-of t) (with l (focus-variants-of t)
(assuming (<= (length l) 1) (assuming (<= (length l) 1)
(inert ((eval (focus-tag-name (tree-label t))) (noop) (noop)))) (inert ((eval (focus-tag-name (tree-label t))) (noop) (noop))))
(assuming (> (length l) 1) (assuming (> (length l) 1)
(-> (eval (focus-tag-name (tree-label t))) (-> (eval (focus-tag-name (tree-label t)))
(dynamic (focus-variant-menu t))))) (dynamic (focus-variant-menu t)))))
(dynamic (focus-toggle-menu t)) (dynamic (focus-toggle-menu t))
(dynamic (focus-position-float-menu t)) (dynamic (focus-float-menu t))
(dynamic (focus-animate-menu t))
(dynamic (focus-misc-menu t))
(assuming (focus-has-preferences? t) (assuming (focus-has-preferences? t)
(-> "Preferences" (-> "Preferences"
(dynamic (focus-preferences-menu t)))) (dynamic (focus-preferences-menu t))))
("Describe" (focus-help)) ("Describe" (focus-help))
(assuming (focus-can-search? t) (assuming (focus-can-search? t)
("Search in database" (focus-open-search-tool t))) ("Search in database" (focus-open-search-tool t)))
("Delete" (remove-structure-upwards))) ("Delete" (remove-structure-upwards)))
(tm-menu (focus-move-menu t) (tm-menu (focus-move-menu t)
("Previous similar" (traverse-previous)) ("Previous similar" (traverse-previous))
skipping to change at line 432 skipping to change at line 401
(alternate-toggle (focus-tree)))) (alternate-toggle (focus-tree))))
(assuming (alternate-second? t) (assuming (alternate-second? t)
((check (balloon (icon (eval (alternate-second-icon t))) ((check (balloon (icon (eval (alternate-second-icon t)))
(eval (alternate-second-name t))) "v" #t) (eval (alternate-second-name t))) "v" #t)
(alternate-toggle (focus-tree)))) (alternate-toggle (focus-tree))))
(assuming (!= (tree-children t) (tree-accessible-children t)) (assuming (!= (tree-children t) (tree-accessible-children t))
((check (balloon (icon "tm_show_hidden.xpm") "Show hidden") "v" ((check (balloon (icon "tm_show_hidden.xpm") "Show hidden") "v"
(tree-is? t :up 'inactive)) (tree-is? t :up 'inactive))
(inactive-toggle t)))) (inactive-toggle t))))
(tm-menu (focus-position-float-icons t)) (tm-menu (focus-float-icons t))
(tm-menu (focus-animate-icons t))
(tm-menu (focus-misc-icons t))
(tm-menu (focus-tag-extra-icons t)) (tm-menu (focus-tag-extra-icons t))
(tm-menu (focus-tag-icons t) (tm-menu (focus-tag-icons t)
(dynamic (focus-toggle-icons t)) (dynamic (focus-toggle-icons t))
(dynamic (focus-position-float-icons t)) (dynamic (focus-float-icons t))
(dynamic (focus-animate-icons t))
(dynamic (focus-misc-icons t))
(mini #t (mini #t
(with l (focus-variants-of t) (with l (focus-variants-of t)
(assuming (<= (length l) 1) (assuming (<= (length l) 1)
(inert ((eval (focus-tag-name (tree-label t))) (noop)))) (inert ((eval (focus-tag-name (tree-label t))) (noop))))
(assuming (> (length l) 1) (assuming (> (length l) 1)
(=> (balloon (eval (focus-tag-name (tree-label t))) (=> (balloon (eval (focus-tag-name (tree-label t)))
"Structured variant") "Structured variant")
(dynamic (focus-variant-menu t)))))) (dynamic (focus-variant-menu t))))))
(dynamic (focus-tag-extra-icons t)) (dynamic (focus-tag-extra-icons t))
(assuming (cursor-inside? t) (assuming (cursor-inside? t)
 End of changes. 8 change blocks. 
45 lines changed or deleted 17 lines changed or added

Home  |  About  |  All  |  Newest  |  Fossies Dox  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTPS