"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "TeXmacs/progs/dynamic/fold-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.

fold-menu.scm  (TeXmacs-1.99.4-src):fold-menu.scm  (TeXmacs-1.99.5-src)
skipping to change at line 16 skipping to change at line 16
;; COPYRIGHT : (C) 1999 Joris van der Hoeven ;; COPYRIGHT : (C) 1999 Joris van der Hoeven
;; ;;
;; This software falls under the GNU general public license version 3 or later. ;; This software falls under the GNU general public license version 3 or later.
;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE ;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE
;; in the root directory or <http://www.gnu.org/licenses/gpl-3.0.html>. ;; in the root directory or <http://www.gnu.org/licenses/gpl-3.0.html>.
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(texmacs-module (dynamic fold-menu) (texmacs-module (dynamic fold-menu)
(:use (dynamic fold-edit) (:use (dynamic fold-edit)
(generic generic-menu))) (generic generic-menu)
(generic document-menu)
(generic format-widgets)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Menus for direct folding and switching ;; Menus for direct folding and switching
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(menu-bind fold-menu (menu-bind fold-menu
(when (with t (tree-innermost dynamic-context?) (when (with t (tree-innermost dynamic-context?)
(and t (toggle-second-context? t))) (and t (toggle-second-context? t)))
("Fold" (dynamic-previous))) ("Fold" (dynamic-previous)))
(when (with t (tree-innermost dynamic-context?) (when (with t (tree-innermost dynamic-context?)
(and t (toggle-first-context? t))) (and t (toggle-first-context? t)))
("Unfold" (dynamic-next)))) ("Unfold" (dynamic-next))))
(menu-bind switch-menu (menu-bind switch-menu
(when (with t (tree-innermost dynamic-context?) (when (with t (tree-innermost dynamic-context?)
(and t (switch-context? t))) (and t (switch-context? t)))
("Add branch before" (switch-insert-at (focus-tree) :current)) ("Add branch before" (switch-insert-at (focus-tree) :current #f))
("Add branch after" (switch-insert-at (focus-tree) :var-next)) ("Add branch after" (switch-insert-at (focus-tree) :var-next #f))
("Remove this branch" (switch-remove-at (focus-tree) :current)) ("Remove this branch" (switch-remove-at (focus-tree) :current))
--- ---
(when (switch-index (focus-tree)) (when (switch-index (focus-tree))
(when (< 0 (switch-index (focus-tree))) (when (< 0 (switch-index (focus-tree)))
("Switch to first" (dynamic-first))) ("Switch to first" (dynamic-first)))
(when (< 0 (switch-index (focus-tree))) (when (< 0 (switch-index (focus-tree)))
("Switch to previous" (dynamic-previous))) ("Switch to previous" (dynamic-previous)))
(when (< (switch-index (focus-tree)) (switch-index (focus-tree) :last)) (when (< (switch-index (focus-tree)) (switch-index (focus-tree) :last))
("Switch to next" (dynamic-next))) ("Switch to next" (dynamic-next)))
(when (< (switch-index (focus-tree)) (switch-index (focus-tree) :last)) (when (< (switch-index (focus-tree)) (switch-index (focus-tree) :last))
skipping to change at line 286 skipping to change at line 288
(tm-define (standard-options l) (tm-define (standard-options l)
(:require (== l 'tit)) (:require (== l 'tit))
(list "framed-title" "title-bar")) (list "framed-title" "title-bar"))
(tm-define (parameter-show-in-menu? l) (tm-define (parameter-show-in-menu? l)
(:require (== l "title-theme")) (:require (== l "title-theme"))
#f) #f)
(tm-define (slide-propose-title? t) (tm-define (slide-propose-title? t)
(and-with u (tree-ref t :down :down) (and-with u (slide-get-document t)
(and (tree-is? u 'document) (not (tree-is? u 0 'tit))))
(not (tree-is? u 0 'tit)))))
(tm-define (slide-insert-title t) (tm-define (slide-insert-title t)
(with u (tree-ref t :down :down) (and-with u (slide-get-document t)
(tree-insert u 0 '((tit ""))) (tree-insert u 0 '((tit "")))
(tree-go-to u 0 0 0))) (tree-go-to u 0 0 0)))
(tm-define (search-slide-name t) (tm-define (search-slide-name t*)
(cond ((tree-in? t '(shown hidden document)) (with t (slide-get-document t*)
(search-slide-name (tree-ref t 0))) (if (and (tree-is? t 'document)
((tree-is? t 'tit) (tree-is? t 0 'tit))
(texmacs->code (verbatim-expand (tm-ref t 0)) "cork")) (texmacs->code (verbatim-expand (tm-ref t 0 0)) "cork")
(else ""))) "")))
(tm-define (get-slide-name t i) (tm-define (get-slide-name t i)
(with s (search-slide-name t) (with s (search-slide-name t)
(string-append "Slide " (number->string (+ i 1)) (string-append "Slide " (number->string (+ i 1))
(if (== s "") "" (string-append ": " s))))) (if (== s "") "" (string-append ": " s)))))
(tm-menu (focus-slides-menu t) (tm-menu (focus-slides-menu t*)
(for (i (.. 0 (tree-arity t))) (with t (slide-get-switch t*)
((eval (get-slide-name (tree-ref t i) i)) (for (i (.. 0 (tree-arity t)))
(switch-to t i)))) ((eval (get-slide-name (tree-ref t i) i))
(screens-switch-to i)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Graphical slides
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(tm-define (slide-propose-graphics? t)
(and-with u (slide-get-document t)
(or (tm-equal? u '(document ""))
(and (tree-func? u 'document 1)
(tree-is? u 0 'tit))
(and (tree-func? u 'document 2)
(tree-is? u 0 'tit)
(tm-equal? (tree-ref u 1) "")))))
(tm-define (slide-insert-graphics t)
(and-with u (slide-get-document t)
(when (and (tree-func? u 'document 1)
(tree-is? u 0 'tit))
(tree-insert! u 1 (list "")))
(tree-set u :last `(gr-screen (document "")))
(tree-go-to u :last 0 0 0)
(make-graphics
"gr-mode" "point"
"gr-frame" `(tuple "scale" "1cm" (tuple "0gw" "1gh"))
"gr-geometry" `(tuple "geometry" "1gpar" "1gpag" "axis"))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Slide background color
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(tm-widget (slide-page-formatter quit)
(let* ((col (tm->stree (slide-get-bg-color)))
(setter (lambda (c)
(set! col c)
(slide-set-bg-color col)
(refresh-now "slide-color-sample"))))
(padded
(bold (text "Background color"))
===
(hlist
(refreshable "slide-color-sample"
(resize "150px" "100px"
(texmacs-output `(document
(block
(tformat
(cwith "1" "1" "1" "1" "cell-width" "140px")
(cwith "1" "1" "1" "1" "cell-height" "90px")
(cwith "1" "1" "1" "1" "cell-vmode" "exact")
(cwith "1" "1" "1" "1" "cell-background" ,col)
(table (row (cell ""))))))
`(style (tuple "generic")))))
// // //
(explicit-buttons
(vlist
("Color" (interactive-color setter (list)))
("Pattern" (open-pattern-selector setter "1cm"))
(glue #f #t 0 0))))
======
(explicit-buttons
(hlist
>>>
("Ok" (quit)))))))
(tm-define (open-page-format)
(:require (or (inside? 'screens) (inside? 'slideshow)))
(dialogue-window slide-page-formatter noop "Page format"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Menus shen focus is on 'screens' tag ;; Menus when focus is on 'screens' tag
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(tm-define (focus-can-move? t) (tm-define (focus-can-move? t)
(:require (tree-is? t 'screens)) (:require (screens-context? t))
#f) #f)
(tm-menu (focus-tag-menu t)
(:require (screens-context? t))
(inert ((eval (focus-tag-name (tree-label t))) (noop) (noop)))
(-> (eval (upcase-first (get-init "page-type")))
(link document-page-size-menu))
(-> (eval (upcase-first (get-init-page-rendering)))
(link page-rendering-menu))
(-> "Preferences"
(dynamic (focus-preferences-menu t)))
("Describe" (focus-help)))
(tm-menu (standard-focus-menu t) (tm-menu (standard-focus-menu t)
(:require (tree-is? t 'screens)) (:require (screens-context? t))
(dynamic (focus-style-menu t)) (dynamic (focus-style-menu t))
--- ---
(dynamic (focus-tag-menu t)) (dynamic (focus-tag-menu t))
--- ---
(dynamic (focus-insert-menu t)) (dynamic (focus-insert-menu t))
--- ---
(dynamic (focus-slides-menu t)) (dynamic (focus-slides-menu t))
(assuming (slide-propose-title? t) (assuming (slide-propose-title? t)
--- ---
("Title" (slide-insert-title t)))) ("Title" (slide-insert-title t)))
(assuming (slide-propose-graphics? t)
---
("Draw" (slide-insert-graphics t))))
(tm-menu (focus-tag-icons t)
(:require (screens-context? t))
(mini #t (inert ((eval (focus-tag-name (tree-label t))) (noop))))
(=> (balloon (eval (upcase-first (get-init "page-type")))
"Paper size")
(link document-page-size-menu))
(=> (balloon (icon (eval (current-page-icon))) "Page layout")
(link page-rendering-menu))
(assuming (focus-has-preferences? t)
(=> (balloon (icon "tm_focus_prefs.xpm") "Preferences for tag")
(dynamic (focus-preferences-menu t))))
((balloon (icon "tm_focus_help.xpm") "Describe tag")
(focus-help)))
(tm-menu (standard-focus-icons t) (tm-menu (standard-focus-icons t)
(:require (tree-is? t 'screens)) (:require (screens-context? t))
(dynamic (focus-style-icons t)) (dynamic (focus-style-icons t))
// //
(minibar (dynamic (focus-insert-icons t))) (minibar (dynamic (focus-insert-icons t)))
// //
(minibar (dynamic (focus-tag-icons t))) (minibar (dynamic (focus-tag-icons t)))
// //
(with i (tree-index (tree-down t)) (with u (slide-get-switch t)
(mini #t (with i (tree-index (tree-down u))
(=> (eval (get-slide-name (tree-ref t i) i)) (mini #t
(dynamic (focus-slides-menu t))))) (=> (eval (get-slide-name (tree-ref u i) i))
(dynamic (focus-slides-menu t))))))
(assuming (slide-propose-title? t) (assuming (slide-propose-title? t)
// //
(minibar (minibar
((balloon "Title" "Insert title") (slide-insert-title t))))) ((balloon "Title" "Insert title") (slide-insert-title t))))
(assuming (slide-propose-graphics? t)
//
(minibar
((balloon "Draw" "Draw graphics") (slide-insert-graphics t)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Menu customizations for overlays ;; Menu customizations for overlays
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(tm-define (focus-can-insert-remove? t) (tm-define (focus-can-insert-remove? t)
(:require (overlays-context? t)) (:require (overlays-context? t))
#t) #t)
(tm-define (focus-can-insert? t) (tm-define (focus-can-insert? t)
skipping to change at line 370 skipping to change at line 471
#t) #t)
(tm-define (focus-can-remove? t) (tm-define (focus-can-remove? t)
(:require (overlays-context? t)) (:require (overlays-context? t))
#t) #t)
(tm-define (parameter-show-in-menu? l) (tm-define (parameter-show-in-menu? l)
(:require (== l "overlay-nr")) (:require (== l "overlay-nr"))
#f) #f)
(define (get-overlays-menu-name t) (define (get-overlays-menu-name prefix t)
(let* ((cur (overlays-current t)) (let* ((cur (overlays-current t))
(tot (overlays-arity t))) (tot (overlays-arity t)))
(set! cur (if cur (number->string cur) "?")) (set! cur (if cur (number->string cur) "?"))
(set! tot (if tot (number->string tot) "?")) (set! tot (if tot (number->string tot) "?"))
(string-append "Overlay " cur "/" tot))) (string-append prefix cur "/" tot)))
(tm-menu (focus-overlays-menu t) (tm-menu (focus-overlays-menu t)
(for (i (.. 1 (or (+ (overlays-arity t) 1) 2))) (for (i (.. 1 (or (+ (overlays-arity t) 1) 2)))
((eval (string-append "Overlay " (number->string i))) ((eval (string-append "Overlay " (number->string i)))
(overlays-switch-to t i)))) (overlays-switch-to t i))))
(tm-menu (focus-hidden-menu t) (tm-menu (focus-hidden-menu t)
(:require (overlays-context? t)) (:require (overlays-context? t))
--- ---
(dynamic (focus-overlays-menu t))) (dynamic (focus-overlays-menu t)))
(tm-menu (focus-hidden-icons t) (tm-menu (focus-hidden-icons t)
(:require (overlays-context? t)) (:require (overlays-context? t))
// //
(=> (eval (get-overlays-menu-name t)) (=> (eval (get-overlays-menu-name "Overlay " t))
(dynamic (focus-overlays-menu t)))) (dynamic (focus-overlays-menu t))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Menu customizations for overlay filters ;; Menu customizations for overlay filters
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(tm-menu (focus-overlay-icon t i here?) (tm-menu (focus-overlay-icon t i here?)
((eval (if here? ((eval (if here?
(string-append "[" (number->string i) "]") (string-append "[" (number->string i) "]")
(number->string i))) (number->string i)))
skipping to change at line 414 skipping to change at line 515
(for (i (.. 1 (or (+ (overlay-arity t) 1) 2))) (for (i (.. 1 (or (+ (overlay-arity t) 1) 2)))
(if (overlay-visible? t i) (if (overlay-visible? t i)
(bold (dynamic (focus-overlay-icon t i (== i (overlay-current t)))))) (bold (dynamic (focus-overlay-icon t i (== i (overlay-current t))))))
(if (not (overlay-visible? t i)) (if (not (overlay-visible? t i))
(grey (dynamic (focus-overlay-icon t i (== i (overlay-current t)))))))) (grey (dynamic (focus-overlay-icon t i (== i (overlay-current t))))))))
(tm-menu (focus-hidden-icons t) (tm-menu (focus-hidden-icons t)
(:require (overlay-context? t)) (:require (overlay-context? t))
// //
(dynamic (focus-overlay-icons t))) (dynamic (focus-overlay-icons t)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Overlays in graphics mode
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (proviso-name p)
(cond ((== p "mixed") "mixed")
((tm-func? p 'show-this 1) "=")
((tm-func? p 'show-from 1) ">=")
((tm-func? p 'show-until 1) "<=")
(else "*")))
(tm-menu (graphics-overlays-mode-menu)
(let* ((t (tree-innermost overlays-context?))
(cur (and t (number->string (overlays-current t)))))
("This" (graphics-set-proviso `(show-this ,cur)))
("From" (graphics-set-proviso `(show-from ,cur)))
("Until" (graphics-set-proviso `(show-until ,cur)))
("Always" (graphics-set-proviso "default"))))
(tm-menu (graphics-focus-overlays-menu)
(with t (tree-innermost overlays-context?)
(assuming (nnot t)
---
(-> "Overlay mode"
(link graphics-overlays-mode-menu))
(-> (eval (get-overlays-menu-name "Overlay " t))
(dynamic (focus-overlays-menu t))))))
(tm-menu (graphics-focus-overlays-icons)
(with t (tree-innermost overlays-context?)
(assuming (nnot t)
/
(mini #t
(group "Overlay:")
(=> (eval (proviso-name (graphics-get-proviso)))
(link graphics-overlays-mode-menu))
(=> (eval (get-overlays-menu-name "" t))
(dynamic (focus-overlays-menu t)))))))
(tm-menu (graphics-screens-menu)
(with t (tree-innermost screens-context?)
(assuming (nnot t)
("Insert slide before" (structured-insert-horizontal t #f))
("Insert slide after" (structured-insert-horizontal t #t))
("Remove slide before" (structured-remove-horizontal t #f))
("Remove slide after" (structured-remove-horizontal t #t)))))
(tm-menu (graphics-overlays-manage-menu)
(with t (tree-innermost overlays-context?)
(assuming (nnot t)
("Insert overlay before" (structured-insert-horizontal t #f))
("Insert overlay after" (structured-insert-horizontal t #t))
("Remove overlay before" (structured-remove-horizontal t #f))
("Remove overlay after" (structured-remove-horizontal t #t)))))
(tm-menu (graphics-overlays-menu)
(with t (tree-innermost overlays-context?)
(assuming (not t)
("Insert overlay before" (make-gr-overlays #f))
("Insert overlay after" (make-gr-overlays #t)))
(assuming t
(link graphics-overlays-manage-menu))))
 End of changes. 18 change blocks. 
30 lines changed or deleted 131 lines changed or added

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