"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "TeXmacs/progs/kernel/gui/menu-define.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.

menu-define.scm  (TeXmacs-1.99.4-src):menu-define.scm  (TeXmacs-1.99.5-src)
skipping to change at line 517 skipping to change at line 517
`(menu-dynamic `(menu-dynamic
(dynamic (standard-color-menu (lambda (answer) ,@(cdr x)))))) (dynamic (standard-color-menu (lambda (answer) ,@(cdr x))))))
(extend-table gui-make-table (extend-table gui-make-table
(pick-color ,gui-make-pick-color)) (pick-color ,gui-make-pick-color))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Basic pattern picker ;; Basic pattern picker
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (standard-pattern-list scale) (define-public (tm-pattern name w h)
(let* ((dir "$TEXMACS_PATH/misc/patterns") (cond ((url-exists? (url-append "$TEXMACS_PATTERN_PATH" (url-tail name)))
(l (url-read-directory dir "*.png")) `(pattern ,(url->unix (url-tail name)) ,w ,h))
((string-starts? (url->unix (url->delta-unix name)) "../")
(when (url? name) (set! name (url->unix name)))
`(pattern ,name ,w ,h))
(else
`(pattern ,(url->unix (url->delta-unix name)) ,w ,h))))
(define (standard-pattern-list dir scale)
(let* ((l1 (url-read-directory dir "*.png"))
(l2 (url-read-directory dir "*.jpg"))
(l3 (url-read-directory dir "*.gif"))
(l (append l1 l2 l3))
(d (map (cut url-delta (string-append dir "/x") <>) l)) (d (map (cut url-delta (string-append dir "/x") <>) l))
(f (map (lambda (x) (string-append dir "/" (url->unix x))) d))) (f (map (lambda (x) (string-append dir "/" (url->unix x))) d)))
(map (lambda (x) `(pattern ,x ,scale "")) f))) (map (lambda (x) (tm-pattern x scale "")) f)))
(tm-menu (standard-pattern-menu cmd scale) (tm-menu (standard-pattern-menu cmd dir scale)
(tile 8 (tile 8
(for (col (standard-pattern-list scale)) (for (col (standard-pattern-list dir scale))
(explicit-buttons (with col2 (tm-pattern (cadr col) "100%" "100@")
((color col #f #f 32 24) (explicit-buttons
(cmd col)))))) ((color col2 #f #f 32 32)
(cmd col)))))))
(define-public (clipart-list)
(list-filter
(list (list "Hatch" "/opt/local/share/openclipart/special/patterns")
(list "Personal" "~/patterns")
(list "Simple" "~/simple-tiles"))
(lambda (p) (url-exists? (cadr p)))))
(tm-menu (clipart-pattern-menu cmd scale)
(for (p (clipart-list))
(-> (eval (car p))
(dynamic (standard-pattern-menu cmd (cadr p) scale)))))
(define (gui-make-pick-background x) (define (gui-make-pick-background x)
`(menu-dynamic `(menu-dynamic
(dynamic (standard-color-menu (lambda (answer) ,@(cddr x)))) (dynamic (standard-color-menu (lambda (answer) ,@(cddr x))))
(glue #f #f 0 5) (glue #f #f 0 5)
(dynamic (standard-pattern-menu (lambda (answer) ,@(cddr x)) ,(cadr x))))) (dynamic (standard-pattern-menu (lambda (answer) ,@(cddr x))
"$TEXMACS_PATH/misc/patterns"
,(cadr x)))
(assuming (nnull? (clipart-list))
---
(dynamic (clipart-pattern-menu (lambda (answer) ,@(cddr x))
,(cadr x))))))
(extend-table gui-make-table (extend-table gui-make-table
(pick-background ,gui-make-pick-background)) (pick-background ,gui-make-pick-background))
(tm-define (allow-pattern-colors?) (tm-define (allow-pattern-colors?)
(qt-gui?)) (qt-gui?))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Extra RGB color picker ;; Extra RGB color picker
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 End of changes. 5 change blocks. 
10 lines changed or deleted 40 lines changed or added

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