"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "TeXmacs/progs/fonts/font-new-widgets.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.

font-new-widgets.scm  (TeXmacs-1.99.4-src):font-new-widgets.scm  (TeXmacs-1.99.5-src)
skipping to change at line 46 skipping to change at line 46
"<iota><kappa><lambda><mu><nu><xi><omicron><pi>" "<iota><kappa><lambda><mu><nu><xi><omicron><pi>"
"<rho><sigma><tau><upsilon><varphi><psi><chi><omega>") "<rho><sigma><tau><upsilon><varphi><psi><chi><omega>")
,(string-append ,(string-append
"Cyrillic: <#430><#431><#432><#433><#434><#435><#436><#437>" "Cyrillic: <#430><#431><#432><#433><#434><#435><#436><#437>"
"<#438><#439><#43A><#43B><#43C><#43D><#43E><#43F>" "<#438><#439><#43A><#43B><#43C><#43D><#43E><#43F>"
"<#440><#441><#442><#443><#444><#445><#446><#447>" "<#440><#441><#442><#443><#444><#445><#446><#447>"
"<#448><#449><#44A><#44B><#44C><#44D><#44E><#44F>") "<#448><#449><#44A><#44B><#44C><#44D><#44E><#44F>")
,(string-append ,(string-append
"Mathematics: <leq><geq><leqslant><geqslant><prec><succ> " "Mathematics: <leq><geq><leqslant><geqslant><prec><succ> "
"<leftarrow><rightarrow><Leftarrow><Rightarrow><mapsto> " "<leftarrow><rightarrow><Leftarrow><Rightarrow><mapsto> "
"<times><cdot><oplus><otimes>")))) "<times><cdot><oplus><otimes>")
(concat "Variants: " (strong "Bold") " " (em "Italic")
" " (name "Small Capitals") " " (samp "Sans Serif")
" " (kbd "Typewriter")))))
(define (math-selector-text)
`(with "par-par-sep" "0.2em"
(document
(concat "Lowercase Roman: "
(math "a b c d e f g h i j k l m n o p q r s t u v w x y z"))
(concat "Uppercase Roman: "
(math "A B C D E F G H I J K L M N O P Q R S T U V W X Y Z"))
(concat "Lowercase Greek: "
(math ,(string-append
"<alpha> <beta> <gamma> <delta> <varepsilon> <zeta> <eta>"
" <theta> <iota> <kappa> <lambda> <mu> <nu> <xi> <omicron>"
" <pi> <rho> <sigma> <tau> <upsilon> <varphi> <psi>"
" <chi> <omega>")))
(concat "Uppercase Greek: "
(math ,(string-append
"<Alpha> <Beta> <Gamma> <Delta> <Epsilon> <Zeta> <Eta>"
" <Theta> <Iota> <Kappa> <Lambda> <Mu> <Nu> <Xi> <Omicron>"
" <Pi> <Rho> <Sigma> <Tau> <Upsilon> <Phi> <Psi>"
" <Chi> <Omega>")))
(concat "Blackboard bold: "
(math ,(string-append
"<bbb-A> <bbb-B> <bbb-C> <bbb-D> <bbb-E> <bbb-F> <bbb-G>"
" <bbb-H> <bbb-I> <bbb-J> <bbb-K> <bbb-L> <bbb-M> <bbb-N>"
" <bbb-O> <bbb-P> <bbb-Q> <bbb-R> <bbb-S> <bbb-T> <bbb-U>"
" <bbb-V> <bbb-W> <bbb-X> <bbb-Y> <bbb-Z>")))
(concat "Calligraphic: "
(math ,(string-append
"<cal-A> <cal-B> <cal-C> <cal-D> <cal-E> <cal-F> <cal-G>"
" <cal-H> <cal-I> <cal-J> <cal-K> <cal-L> <cal-M> <cal-N>"
" <cal-O> <cal-P> <cal-Q> <cal-R> <cal-S> <cal-T> <cal-U>"
" <cal-V> <cal-W> <cal-X> <cal-Y> <cal-Z>")))
(concat "Fraktur: "
(math ,(string-append
"<frak-A> <frak-B> <frak-C> <frak-D> <frak-E> <frak-F>"
" <frak-G> <frak-H> <frak-I> <frak-J> <frak-K> <frak-L>"
" <frak-M> <frak-N> <frak-O> <frak-P> <frak-Q> <frak-R>"
" <frak-S> <frak-T> <frak-U> <frak-V> <frak-W> <frak-X>"
" <frak-Y> <frak-Z>"))))))
(define-public sample-text (standard-selector-text)) (define-public sample-text (standard-selector-text))
(define-public sample-kind "Standard") (define-public sample-kind "Standard")
(tm-define (set-font-sample-range hexa-start hexa-end) (tm-define (set-font-sample-range hexa-start hexa-end)
(:argument hexa-start "First unicode character in hexadecimal") (:argument hexa-start "First unicode character in hexadecimal")
(:argument hexa-end "Last unicode character in hexadecimal") (:argument hexa-end "Last unicode character in hexadecimal")
(set! sample-text (set! sample-text
(build-character-table (hexadecimal->integer hexa-start) (build-character-table (hexadecimal->integer hexa-start)
(hexadecimal->integer hexa-end)))) (hexadecimal->integer hexa-end))))
(define (set-font-sample-kind kind) (define (set-font-sample-kind kind)
(set! sample-kind kind) (set! sample-kind kind)
(cond ((== kind "ASCII") (cond ((== kind "Mathematics")
(set! sample-text (math-selector-text)))
((== kind "ASCII")
(set-font-sample-range "20" "7f")) (set-font-sample-range "20" "7f"))
((== kind "Latin") ((== kind "Latin")
(set-font-sample-range "80" "ff")) (set-font-sample-range "80" "ff"))
((== kind "Greek") ((== kind "Greek")
(set-font-sample-range "380" "3ff")) (set-font-sample-range "380" "3ff"))
((== kind "Cyrillic") ((== kind "Cyrillic")
(set-font-sample-range "400" "4ff")) (set-font-sample-range "400" "4ff"))
((== kind "CJK") ((== kind "CJK")
(set-font-sample-range "4e00" "9fcc")) (set-font-sample-range "4e00" "9fcc"))
((== kind "Hangul") ((== kind "Hangul")
skipping to change at line 122 skipping to change at line 166
(ser (getter "font-series")) (ser (getter "font-series"))
(sh (getter "font-shape")) (sh (getter "font-shape"))
(sz (getter "font-base-size")) (sz (getter "font-base-size"))
(lf (logical-font-private fam var ser sh)) (lf (logical-font-private fam var ser sh))
(fn (logical-font-search-exact lf))) (fn (logical-font-search-exact lf)))
;;(display* "lf= " lf "\n") ;;(display* "lf= " lf "\n")
;;(display* "fn= " fn "\n") ;;(display* "fn= " fn "\n")
(set! selector-font-family (car fn)) (set! selector-font-family (car fn))
(set! selector-font-style (cadr fn)) (set! selector-font-style (cadr fn))
(set! selector-font-size sz) (set! selector-font-size sz)
(selector-initialize-search))) (selector-initialize-search)
(selector-initialize-customize getter)))
(tm-define (selector-get-changes getter) (tm-define (selector-get-changes getter)
(if (== selector-font-style "Unknown") (if (== selector-font-style "Unknown")
(list) (list)
(with fn (selector-get-font) (with fn (selector-get-font)
(with l '() (with l '()
(when (!= (selector-font-effects) (getter "font-effects"))
(set! l (cons* "font-effects" (selector-font-effects) l)))
(when (!= selector-font-size (getter "font-base-size")) (when (!= selector-font-size (getter "font-base-size"))
(set! l (cons* "font-base-size" selector-font-size l))) (set! l (cons* "font-base-size" selector-font-size l)))
(when (!= (logical-font-shape fn) (getter "font-shape")) (when (!= (logical-font-shape fn) (getter "font-shape"))
(set! l (cons* "font-shape" (logical-font-shape fn) l))) (set! l (cons* "font-shape" (logical-font-shape fn) l)))
(when (!= (logical-font-series fn) (getter "font-series")) (when (!= (logical-font-series fn) (getter "font-series"))
(set! l (cons* "font-series" (logical-font-series fn) l))) (set! l (cons* "font-series" (logical-font-series fn) l)))
(when (!= (logical-font-variant fn) (getter "font-family")) (when (!= (logical-font-variant fn) (getter "font-family"))
(set! l (cons* "font-family" (logical-font-variant fn) l))) (set! l (cons* "font-family" (logical-font-variant fn) l)))
(when (!= (logical-font-family fn) (getter "font")) (when (!= (logical-font-family* fn) (getter "font"))
(set! l (cons* "font" (logical-font-family fn) l))) (set! l (cons* "font" (logical-font-family* fn) l)))
l)))) l))))
(define (selector-font-simulate-comment) (define (selector-font-simulate-comment)
(let* ((fn (selector-get-font)) (let* ((fn (selector-get-font))
(fam (logical-font-family fn)) (fam (logical-font-family fn))
(var (logical-font-variant fn)) (var (logical-font-variant fn))
(ser (logical-font-series fn)) (ser (logical-font-series fn))
(sh (logical-font-shape fn)) (sh (logical-font-shape fn))
(lf (logical-font-private fam var ser sh)) (lf (logical-font-private fam var ser sh))
(fn2 (logical-font-search lf)) (fn2 (logical-font-search lf))
skipping to change at line 164 skipping to change at line 211
(== selector-font-style (cadr fn2)) (== selector-font-style (cadr fn2))
(== sel "")) (== sel ""))
"" ""
(string-append " (" selector-font-family " " selector-font-style (string-append " (" selector-font-family " " selector-font-style
(if (== sel "") "" " + ") sel (if (== sel "") "" " + ") sel
" -> " (car fn2) " " (cadr fn2) ")")))) " -> " (car fn2) " " (cadr fn2) ")"))))
(define (selector-font-demo-text) (define (selector-font-demo-text)
(with fn (selector-get-font) (with fn (selector-get-font)
;;(display* "Font: " fn "\n") ;;(display* "Font: " fn "\n")
;;(display* "Internal font: " (logical-font-family fn) ;;(display* "Internal font: " (logical-font-family* fn)
;; ", " (logical-font-variant fn) ;; ", " (logical-font-variant fn)
;; ", " (logical-font-series fn) ;; ", " (logical-font-series fn)
;; ", " (logical-font-shape fn) ;; ", " (logical-font-shape fn)
;; ", " selector-font-size "\n") ;; ", " selector-font-size "\n")
`(document `(document
(with (with
"font" ,(logical-font-family fn) "font" ,(logical-font-family* fn)
"font-family" ,(logical-font-variant fn) "font-family" ,(logical-font-variant fn)
"font-series" ,(logical-font-series fn) "font-series" ,(logical-font-series fn)
"font-shape" ,(logical-font-shape fn) "font-shape" ,(logical-font-shape fn)
"font-base-size" ,selector-font-size "font-base-size" ,selector-font-size
"font-effects" ,(selector-font-effects)
,sample-text)))) ,sample-text))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Global state for font searching ;; Global state for font searching
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(tm-define selector-search-weight "Any") (tm-define selector-search-weight "Any")
(tm-define selector-search-slant "Any") (tm-define selector-search-slant "Any")
(tm-define selector-search-stretch "Any") (tm-define selector-search-stretch "Any")
(tm-define selector-search-serif "Any") (tm-define selector-search-serif "Any")
skipping to change at line 236 skipping to change at line 284
(delayed (delayed
(refresh-now "font-family-selector")))) (refresh-now "font-family-selector"))))
(tm-define (selected-families) (tm-define (selected-families)
(search-font-families (selected-properties))) (search-font-families (selected-properties)))
(tm-define (selected-styles family) (tm-define (selected-styles family)
(search-font-styles family (selected-properties))) (search-font-styles family (selected-properties)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Global state for font customization
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(tm-define (selector-customize?)
(== (get-preference "advanced font customization") "on"))
(tm-define (selector-customize! on?)
(if on?
(set-preference "advanced font customization" "on")
(reset-preference "advanced font customization"))
(refresh-now "font-customized-selector"))
(tm-define selector-customize-table (make-ahash-table))
(tm-define (selector-customize-get which default)
(or (ahash-ref selector-customize-table which) default))
(tm-define (selector-customize-set! which val)
(if (or (== val "") (== val "default") (== val "Default")
(== val (font-effect-default which)))
(ahash-remove! selector-customize-table which)
(ahash-set! selector-customize-table which val)))
(tm-define (selector-customize-get* which default)
(with val (selector-customize-get which default)
(cond ((== val "roman") "TeXmacs Computer Modern")
((== val "bonum") "TeX Gyre Bonum")
((== val "pagella") "TeX Gyre Pagella")
((== val "schola") "TeX Gyre Schola")
((== val "termes") "TeX Gyre Termes")
(else val))))
(tm-define (selector-customize-set!* which val)
(cond ((== val "TeXmacs Computer Modern") (set! val "roman"))
((== val "TeX Gyre Bonum") (set! val "bonum"))
((== val "TeX Gyre Pagella") (set! val "pagella"))
((== val "TeX Gyre Schola") (set! val "schola"))
((== val "TeX Gyre Termes") (set! val "termes")))
(selector-customize-set! which val))
(define (selector-initialize-customize getter)
(let* ((fam (getter "font"))
(effs (getter "font-effects")))
(set! selector-customize-table (make-ahash-table))
(for (kv (string-tokenize-by-char fam #\,))
(with l (string-tokenize-by-char kv #\=)
(when (== (length l) 2)
(with (var val) l
(when (in? var '("bold" "italic" "smallcaps" "sansserif"
"typewriter" "math" "greek" "bbb" "cal" "frak"))
(ahash-set! selector-customize-table var val))))))
(for (kv (string-tokenize-by-char effs #\,))
(with l (string-tokenize-by-char kv #\=)
(when (== (length l) 2)
(with (var val) l
(cond ((== var "bold")
(ahash-set! selector-customize-table "embold" val))
((== var "bbb")
(ahash-set! selector-customize-table "embbb" val))
((in? var '("slant" "hmagnify" "vmagnify"
"hextended" "vextended"))
(ahash-set! selector-customize-table var val)))))))))
(define (logical-font-family* fn)
(let* ((fam (logical-font-family fn))
(bf (selector-customize-get "bold" #f))
(it (selector-customize-get "italic" #f))
(sc (selector-customize-get "smallcaps" #f))
(ss (selector-customize-get "sansserif" #f))
(tt (selector-customize-get "typewriter" #f))
(math (selector-customize-get "math" #f))
(greek (selector-customize-get "greek" #f))
(bbb (selector-customize-get "bbb" #f))
(cal (selector-customize-get "cal" #f))
(frak (selector-customize-get "frak" #f)))
(if bf (set! fam (string-append "bold=" bf "," fam)))
(if it (set! fam (string-append "italic=" it "," fam)))
(if sc (set! fam (string-append "smallcaps=" sc "," fam)))
(if ss (set! fam (string-append "sansserif=" ss "," fam)))
(if tt (set! fam (string-append "typewriter=" tt "," fam)))
(if math (set! fam (string-append "math=" math "," fam)))
(if greek (set! fam (string-append "greek=" greek "," fam)))
(if bbb (set! fam (string-append "bbb=" bbb "," fam)))
(if cal (set! fam (string-append "cal=" cal "," fam)))
(if frak (set! fam (string-append "frak="frak "," fam)))
fam))
(define (selector-font-effects)
(let* ((effs (list))
(embold (selector-customize-get "embold" #f))
(embbb (selector-customize-get "embbb" #f))
(slant (selector-customize-get "slant" #f))
(hmag (selector-customize-get "hmagnify" #f))
(vmag (selector-customize-get "vmagnify" #f))
(hext (selector-customize-get "hextended" #f))
(vext (selector-customize-get "vextended" #f)))
(with add (lambda (var val)
(when val
(set! effs (rcons effs (string-append var "=" val)))))
(add "hmagnify" hmag)
(add "vmagnify" vmag)
(add "hextended" hext)
(add "vextended" vext)
(add "bold" embold)
(add "bbb" embbb)
(add "slant" slant)
(string-recompose effs ","))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Font selector ;; Font selector
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(tm-define (font-default-sizes) (tm-define (font-default-sizes)
'("5" "6" "7" "8" "9" "10" "11" "12" "14" "16" "18" "20" '("5" "6" "7" "8" "9" "10" "11" "12" "14" "16" "18" "20"
"24" "28" "32" "36" "40" "48" "64" "72" "96" "24" "28" "32" "36" "40" "48" "64" "72" "96"
"128" "144" "192")) "128" "144" "192"))
(tm-widget (font-family-selector) (tm-widget (font-family-selector)
(vertical (vertical
(bold (text "Family")) (bold (text "Family"))
=== ===
(resize ("300px" "300px" "2000px") ("325px" "325px" "2000px") (resize "300px" "350px"
(scrollable (scrollable
(choice (set! selector-font-family answer) (choice (set! selector-font-family answer)
(selected-families) (selected-families)
selector-font-family))))) selector-font-family)))))
(tm-widget (font-style-selector) (tm-widget (font-style-selector)
(vertical (vertical
(bold (text "Style")) (bold (text "Style"))
=== ===
(resize ("200px" "200px" "400px") ("325px" "325px" "2000px") (resize "200px" "350px"
(scrollable (scrollable
(choice (set! selector-font-style answer) (choice (set! selector-font-style answer)
(selected-styles selector-font-family) (selected-styles selector-font-family)
selector-font-style))))) selector-font-style)))))
(tm-widget (font-size-selector) (tm-widget (font-size-selector)
(vertical (vertical
(bold (text "Size")) (bold (text "Size"))
=== ===
(resize ("75px" "75px" "75px") ("325px" "325px" "2000px") (resize "75px" "350px"
(scrollable (scrollable
(choice (set! selector-font-size answer) (choice (set! selector-font-size answer)
(font-default-sizes) (font-default-sizes)
selector-font-size))))) selector-font-size)))))
(tm-widget (font-sample-text) (tm-widget (font-sample-text)
(texmacs-output (texmacs-output
`(with "bg-color" "white" `(with "bg-color" "white"
,(selector-font-demo-text)) ,(selector-font-demo-text))
'(style "generic"))) '(style "generic")))
skipping to change at line 339 skipping to change at line 496
'("Any" "Ancient" "Attached" "Calligraphic" "Comic" '("Any" "Ancient" "Attached" "Calligraphic" "Comic"
"Decorative" "Distorted" "Gothic" "Handwritten" "Initials" "Decorative" "Distorted" "Gothic" "Handwritten" "Initials"
"Medieval" "Miscellaneous" "Outline" "Retro" "Scifi" "Title") "Medieval" "Miscellaneous" "Outline" "Retro" "Scifi" "Title")
selector-search-category "120px")) selector-search-category "120px"))
(item ====== ======) (item ====== ======)
(item (text "Glyphs:") (item (text "Glyphs:")
(enum (selector-search-set! selector-search-glyphs answer) (enum (selector-search-set! selector-search-glyphs answer)
'("Any" "ASCII" "Latin" "Greek" "Cyrillic" '("Any" "ASCII" "Latin" "Greek" "Cyrillic"
"CJK" "Hangul" "Math Symbols" "Math Extra" "Math Letters") "CJK" "Hangul" "Math Symbols" "Math Extra" "Math Letters")
selector-search-glyphs "120px"))) selector-search-glyphs "120px")))
(horizontal (glue #f #t 0 0))
;;(horizontal
;; >>>
;; (toggle (selector-customize! answer) (selector-customize?)) ///
;; (text "Advanced customizations")
;; >>>)
))
(define (font-effect-defaults which)
(cond ((== which "embold")
'("1" "1.25" "1.5" "2" "2.5" "3" "3.5" "4" ""))
((== which "embbb")
'("1" "1.5" "2" "2.5" "3" "3.5" "4" "4.5" "5" ""))
((== which "slant")
'("-0.5" "-0.25" "-0.1" "0"
"0.1" "0.2" "0.25" "0.3" "0.4" "0.5" "0.75" "1" ""))
(else
'("0.5" "0.6" "0.7" "0.8" "0.9" "1"
"1.1" "1.2" "1.3" "1.4" "1.5" "1.6" "1.8" "2" ""))))
(define (font-effect-default which)
(cond ((== which "slant") "0")
(else "1")))
(tm-widget (font-effect-selector which)
(enum (selector-customize-set! which answer)
(font-effect-defaults which)
(selector-customize-get which (font-effect-default which)) "50px"))
(tm-widget (font-effects-selector)
(vertical
(aligned
(item (text "Slant:")
(dynamic (font-effect-selector "slant")))
(item (text "Embold:")
(dynamic (font-effect-selector "embold")))
(item (text "Double stroke:")
(dynamic (font-effect-selector "embbb")))
(item (text "Extended:")
(dynamic (font-effect-selector "hextended")))
;;(item (text "Extend vertically:")
;; (dynamic (font-effect-selector "vextended")))
(item (text "Magnify horizontally:")
(dynamic (font-effect-selector "hmagnify")))
(item (text "Magnify vertically:")
(dynamic (font-effect-selector "vmagnify"))))
(horizontal (glue #f #t 0 0))))
(define (default-subfonts-list which)
'("TeXmacs Computer Modern" "Stix"
"TeX Gyre Bonum" "TeX Gyre Pagella"
"TeX Gyre Schola" "TeX Gyre Termes"))
(define (default-subfonts which)
(with l (cons "Default" (default-subfonts-list which))
(if (in? which l)
(append l (list ""))
(append l (list which "")))))
(tm-widget (subfont-selector which)
(enum (selector-customize-set!* which answer)
(default-subfonts (selector-customize-get* which "Default"))
(selector-customize-get* which "Default") "160px"))
(tm-widget (font-variant-selector)
(vertical
(aligned
(item (text "Bold:")
(dynamic (subfont-selector "bold")))
(item (text "Italic:")
(dynamic (subfont-selector "italic")))
(item (text "Small capitals:")
(dynamic (subfont-selector "smallcaps")))
(item (text "Sans serif:")
(dynamic (subfont-selector "sansserif")))
(item (text "Typewriter:")
(dynamic (subfont-selector "typewriter"))))
(horizontal (glue #f #t 0 0))))
(tm-widget (font-math-selector)
(vertical
(aligned
(item (text "Mathematics:")
(dynamic (subfont-selector "math")))
(item (text "Greek:")
(dynamic (subfont-selector "greek")))
(item (text "Blackboard bold:")
(dynamic (subfont-selector "bbb")))
(item (text "Calligraphic:")
(dynamic (subfont-selector "cal")))
(item (text "Fraktur:")
(dynamic (subfont-selector "frak"))))
(horizontal (glue #f #t 0 0)))) (horizontal (glue #f #t 0 0))))
(tm-widget (font-customized-selector)
(assuming (selector-customize?)
=== === ===
(hlist
(bold (text "Font customization"))
>>>)
===
(horizontal
(link font-effects-selector)
>>>
(link font-variant-selector)
>>>
(link font-math-selector))
=== === ===)
(assuming (not (selector-customize?))
=== === ===))
(tm-widget (font-selector-demo) (tm-widget (font-selector-demo)
(hlist (hlist
(bold (text "Sample text")) (bold (text "Sample text"))
(text (selector-font-simulate-comment)) (text (selector-font-simulate-comment))
>>>) >>>)
=== ===
(resize ("300px" "300px" "2000px") ("225px" "225px" "225px") (resize "850px" "225px"
(scrollable (scrollable
(link font-sample-text)))) (link font-sample-text))))
(tm-define (font-import name)
(font-database-extend-local name)
(refresh-now "font-family-selector")
(refresh-now "font-size-selector"))
(tm-widget ((font-selector flag?) quit) (tm-widget ((font-selector flag?) quit)
(padded (padded
(horizontal (horizontal
(refreshable "font-family-selector" (refreshable "font-family-selector"
(link font-family-selector)) (link font-family-selector))
/// ///
(refresh font-style-selector auto) (refresh font-style-selector auto)
/// ///
(refreshable "font-size-selector" (refreshable "font-size-selector"
(link font-size-selector)) (link font-size-selector))
/// ///
(link font-properties-selector)) (link font-properties-selector))
=== === === (refreshable "font-customized-selector"
(link font-customized-selector))
(refresh font-selector-demo auto) (refresh font-selector-demo auto)
=== === === ===
(explicit-buttons (explicit-buttons
(hlist (hlist
(enum (set-font-sample-kind answer) (enum (set-font-sample-kind answer)
'("Standard" "Selection" '("Standard" "Mathematics" "Selection"
"ASCII" "Latin" "Greek" "Cyrillic" "CJK" "Hangul" "ASCII" "Latin" "Greek" "Cyrillic" "CJK" "Hangul"
"Math Symbols" "Math Extra" "Math Letters" "Math Symbols" "Math Extra" "Math Letters"
"Unicode 0000-0fff" "Unicode 1000-1fff" "Unicode 0000-0fff" "Unicode 1000-1fff"
"Unicode 2000-2fff" "Unicode 3000-3fff" "Unicode 2000-2fff" "Unicode 3000-3fff"
"Unicode 4000-4fff") "Unicode 4000-4fff")
(get-font-sample-kind) "120px") (get-font-sample-kind) "120px")
>>> >>>
("Import" (choose-file font-import "Import font" "")) // //
(if flag? (if flag?
("Reset" ("Reset"
(begin (begin
(init-default "font" "font-base-size" (init-default "font" "font-base-size" "math-font" "prog-font"
"font-family" "font-series" "font-shape") "font-family" "font-series" "font-shape"
"font-effects")
(selector-initialize-font get-init) (selector-initialize-font get-init)
(refresh-now "font-family-selector") (refresh-now "font-family-selector")
(refresh-now "font-size-selector"))) (refresh-now "font-size-selector")
(refresh-now "font-customized-selector")))
// // // //
("Ok" (quit (selector-get-changes get-init)))) ("Ok" (quit (selector-get-changes get-init))))
(if (not flag?) (if (not flag?)
("Ok" (quit (selector-get-changes get-env)))))))) ("Ok" (quit (selector-get-changes get-env))))))))
(tm-define (open-font-selector) (tm-define (open-font-selector)
(:interactive #t) (:interactive #t)
(selector-initialize-font get-env) (selector-initialize-font get-env)
(dialogue-window (font-selector #f) make-multi-with "Font selector")) (dialogue-window (font-selector #f) make-multi-with "Font selector"))
 End of changes. 21 change blocks. 
16 lines changed or deleted 291 lines changed or added

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