"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "TeXmacs/progs/generic/format-edit.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.

format-edit.scm  (TeXmacs-1.99.4-src):format-edit.scm  (TeXmacs-1.99.5-src)
skipping to change at line 21 skipping to change at line 21
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(texmacs-module (generic format-edit) (texmacs-module (generic format-edit)
(:use (utils base environment) (:use (utils base environment)
(utils edit selections) (utils edit selections)
(utils library cursor) (utils library cursor)
(generic generic-edit))) (generic generic-edit)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Basic with manipulations
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (with-ref* t var i)
(and (<= i (- (tree-arity t) 3))
(or (and (tm-equal? (tree-ref t i) var)
(tree-ref t (+ i 1)))
(with-ref* t var (+ i 2)))))
(tm-define (with-ref t var)
(and (tm-is? t 'with)
(with-ref* t var 0)))
(tm-define (with-set t var val)
(with old-val (with-ref t var)
(cond (old-val (tree-set! old-val val))
((tree-is? t 'with)
(tree-insert! t (- (tree-arity t) 1) (list var val)))
(else (tree-set! t `(with ,var ,val ,t))))
t))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Simplification ;; Simplification
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (with-simplify-sub t var) (define (with-simplify-sub t var)
(cond ((tree-is-buffer? t) (noop)) (cond ((tree-is-buffer? t) (noop))
((tree-func? t 'document 1) ((tree-func? t 'document 1)
(with-simplify-sub (tree-up t) var)) (with-simplify-sub (tree-up t) var))
((tree-func? t 'with) ((tree-func? t 'with)
(with-simplify-sub (tree-up t) var) (with-simplify-sub (tree-up t) var)
(for (i (reverse (.. 0 (quotient (tree-arity t) 2)))) (for (i (reverse (.. 0 (quotient (tree-arity t) 2))))
skipping to change at line 214 skipping to change at line 236
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Customizable environments ;; Customizable environments
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(tm-define (customizable-context? t) (tm-define (customizable-context? t)
(nnull? (customizable-parameters t))) (nnull? (customizable-parameters t)))
(tm-define (customizable-parameters t) (tm-define (customizable-parameters t)
(list)) (list))
(tm-define (tree-with-set t var val) (tm-define (tree-with-set t . l)
(tree-set! t `(with ,var ,val ,t)) (focus-tree-modified t)
(tree-set! t `(with ,@l ,t))
(with-simplify t) (with-simplify t)
(with-merge t)) (with-merge t))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Spacing ;; Spacing
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(tm-property (make-hspace spc) (tm-property (make-hspace spc)
(:argument spc "Horizontal space")) (:argument spc "Horizontal space"))
skipping to change at line 258 skipping to change at line 281
(make 'page-break) (make 'page-break)
(insert-return)) (insert-return))
(tm-define (make-new-page) (tm-define (make-new-page)
(make 'new-page) (make 'new-page)
(insert-return)) (insert-return))
(tm-define (make-new-dpage) (tm-define (make-new-dpage)
(make 'new-dpage) (make 'new-dpage)
(insert-return)) (insert-return))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Multiple text flows
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(tm-define (focus-has-preferences? t)
(:require (tree-in? t '(float)))
#t)
(tm-define (standard-parameters l)
(:require (== l "float"))
(list "page-float-sep"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Font effects
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(tm-define (customizable-parameters t)
(:require (tree-is? t 'embold))
(list (list "embold-strength" "Strength")))
(tm-define (customizable-parameters t)
(:require (tree-is? t 'embbb))
(list (list "embbb-strength" "Strength")))
(tm-define (customizable-parameters t)
(:require (tree-is? t 'slanted))
(list (list "slanted-slope" "Slope")))
(tm-define (customizable-parameters t)
(:require (tree-is? t 'hmagnified))
(list (list "hmagnified-factor" "Factor")))
(tm-define (customizable-parameters t)
(:require (tree-is? t 'vmagnified))
(list (list "vmagnified-factor" "Factor")))
(tm-define (customizable-parameters t)
(:require (tree-is? t 'condensed))
(list (list "condensed-factor" "Factor")))
(tm-define (customizable-parameters t)
(:require (tree-is? t 'extended))
(list (list "extended-factor" "Factor")))
(tm-define (customizable-parameters t)
(:require (tree-is? t 'degraded))
(list (list "degraded-threshold" "Threshold")
(list "degraded-frequency" "Frequency")))
(tm-define (customizable-parameters t)
(:require (tree-is? t 'distorted))
(list (list "distorted-strength" "Strength")
(list "distorted-frequency" "Frequency")))
(tm-define (customizable-parameters t)
(:require (tree-is? t 'gnawed))
(list (list "gnawed-strength" "Strength")
(list "gnawed-frequency" "Frequency")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Effects
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(tm-define (customizable-parameters t)
(:require (tree-in? t '(blur gaussian-blur oval-blur rectangular-blur)))
(list (list "blur-pen-width" "Pen width")
(list "blur-pen-height" "Pen height")
(list "blur-pen-angle" "Pen angle")))
(tm-define (customizable-parameters t)
(:require (tree-in? t '(motion-blur)))
(list (list "blur-pen-dx" "Pen dx")
(list "blur-pen-dy" "Pen dy")))
(tm-define (customizable-parameters t)
(:require (tree-in? t '(outline gaussian-outline
oval-outline rectangular-outline)))
(list (list "outline-pen-width" "Pen width")
(list "outline-pen-height" "Pen height")
(list "outline-pen-angle" "Pen angle")))
(tm-define (customizable-parameters t)
(:require (tree-in? t '(motion-outline)))
(list (list "outline-pen-dx" "Pen dx")
(list "outline-pen-dy" "Pen dy")))
(tm-define (customizable-parameters t)
(:require (tree-in? t '(thicken gaussian-thicken
oval-thicken rectangular-thicken)))
(list (list "thicken-pen-width" "Pen width")
(list "thicken-pen-height" "Pen height")
(list "thicken-pen-angle" "Pen angle")))
(tm-define (customizable-parameters t)
(:require (tree-in? t '(motion-thicken)))
(list (list "thicken-pen-dx" "Pen dx")
(list "thicken-pen-dy" "Pen dy")))
(tm-define (customizable-parameters t)
(:require (tree-in? t '(erode gaussian-erode oval-erode rectangular-erode)))
(list (list "erode-pen-width" "Pen width")
(list "erode-pen-height" "Pen height")
(list "erode-pen-angle" "Pen angle")))
(tm-define (customizable-parameters t)
(:require (tree-in? t '(motion-erode)))
(list (list "erode-pen-dx" "Pen dx")
(list "erode-pen-dy" "Pen dy")))
(tm-define (customizable-parameters t)
(:require (tree-in? t '(shadow shadowed-raise)))
(list (list "shadow-dx" "Dx")
(list "shadow-dy" "Dy")
(list "shadow-color" "Color")
(list "shadow-blur-radius" "Blur radius")))
(tm-define (customizable-parameters t)
(:require (tree-in? t '(engrave)))
(list (list "engrave-dx" "Dx")
(list "engrave-dy" "Dy")
(list "engrave-color" "Color")))
(tm-define (customizable-parameters t)
(:require (tree-in? t '(emboss)))
(list (list "emboss-dx" "Dx")
(list "emboss-dy" "Dy")
(list "emboss-color" "Color")))
(tm-define (customizable-parameters t)
(:require (tree-in? t '(outlined-engrave)))
(list (list "engrave-dx" "Dx")
(list "engrave-dy" "Dy")
(list "outline-pen-width" "Pen width")
(list "outline-pen-height" "Pen height")
(list "outline-pen-angle" "Pen angle")))
(tm-define (customizable-parameters t)
(:require (tree-in? t '(outlined-emboss)))
(list (list "emboss-dx" "Dx")
(list "emboss-dy" "Dy")
(list "outline-pen-width" "Pen width")
(list "outline-pen-height" "Pen height")
(list "outline-pen-angle" "Pen angle")))
(tm-define (customizable-parameters t)
(:require (tree-in? t '(degrade)))
(list (list "degrade-wavelen-x" "Wave length x")
(list "degrade-wavelen-y" "Wave length y")
(list "degrade-threshold" "Threshold")
(list "degrade-sharpness" "Sharpness")))
(tm-define (customizable-parameters t)
(:require (tree-in? t '(distort)))
(list (list "distort-wavelen-x" "Wave length x")
(list "distort-wavelen-y" "Wave length y")
(list "distort-radius-x" "Radius x")
(list "distort-radius-y" "Radius y")))
(tm-define (customizable-parameters t)
(:require (tree-in? t '(gnaw)))
(list (list "gnaw-wavelen-x" "Wave length x")
(list "gnaw-wavelen-y" "Wave length y")
(list "gnaw-radius-x" "Radius x")
(list "gnaw-radius-y" "Radius y")))
(tm-define (pen-effect-context? t)
(tree-in? t (pen-effect-tag-list)))
(tm-define (get-effect-pen t)
(when (not (tree? t))
(set! t (tree-innermost pen-effect-context?)))
(cond ((not (tree? t)) #f)
((tree-in? t '(blur)) "gaussian")
((tree-in? t '(outline)) "oval")
((tree-in? t '(thicken erode)) "rectangular")
((tree-in? t (gaussian-effect-tag-list)) "gaussian")
((tree-in? t (oval-effect-tag-list)) "oval")
((tree-in? t (rectangular-effect-tag-list)) "rectangular")
((tree-in? t (motion-effect-tag-list)) "motion")
(else #f)))
(define (test-effect-pen? t pen)
(== (get-effect-pen t) pen))
(tm-define (set-effect-pen t pen)
(:check-mark "*" test-effect-pen?)
(when (not (tree? t))
(set! t (tree-innermost pen-effect-context?)))
(cond ((not (tree? t)) (noop))
((tree-in? t '(blur gaussian-blur oval-blur
rectangular-blur motion-blur))
(cond ((== pen "gaussian") (variant-set t 'gaussian-blur))
((== pen "oval") (variant-set t 'oval-blur))
((== pen "rectangular") (variant-set t 'rectangular-blur))
((== pen "motion") (variant-set t 'motion-blur))))
((tree-in? t '(outline gaussian-outline oval-outline
rectangular-outline motion-outline))
(cond ((== pen "gaussian") (variant-set t 'gaussian-outline))
((== pen "oval") (variant-set t 'oval-outline))
((== pen "rectangular") (variant-set t 'rectangular-outline))
((== pen "motion") (variant-set t 'motion-outline))))
((tree-in? t '(thicken gaussian-thicken oval-thicken
rectangular-thicken motion-thicken))
(cond ((== pen "gaussian") (variant-set t 'gaussian-thicken))
((== pen "oval") (variant-set t 'oval-thicken))
((== pen "rectangular") (variant-set t 'rectangular-thicken))
((== pen "motion") (variant-set t 'motion-thicken))))
((tree-in? t '(erode gaussian-erode oval-erode
rectangular-erode motion-erode))
(cond ((== pen "gaussian") (variant-set t 'gaussian-erode))
((== pen "oval") (variant-set t 'oval-erode))
((== pen "rectangular") (variant-set t 'rectangular-erode))
((== pen "motion") (variant-set t 'motion-erode))))))
 End of changes. 3 change blocks. 
2 lines changed or deleted 25 lines changed or added

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