diff options
| -rw-r--r-- | module/output/text.scm | 4 | ||||
| -rw-r--r-- | module/util.scm | 29 |
2 files changed, 27 insertions, 6 deletions
diff --git a/module/output/text.scm b/module/output/text.scm index 7c99e12f..274c79e2 100644 --- a/module/output/text.scm +++ b/module/output/text.scm @@ -23,7 +23,7 @@ (string-concatenate/shared (merge words (map (lambda (n) (make-string n #\space)) space-list) - (let ((f #t)) (lambda _ (mod! f not))))))) + (let ((f #t)) (lambda _ (mod/r! f not))))))) ;; Splits and justifies the given line to @var{#:width}. @@ -34,7 +34,7 @@ (let* ((head tail (take-drop-while (let ((w 0)) (lambda (word) ; Take words until we are above the limit. - (< (mod! w = (+ 1 (string-length word))) + (< (mod/r! w = (+ 1 (string-length word))) width))) lst))) (cond ((null? tail) (list (unwords head))) ; Don't justify last line. diff --git a/module/util.scm b/module/util.scm index 14b6cfde..9a816cee 100644 --- a/module/util.scm +++ b/module/util.scm @@ -6,6 +6,7 @@ for-each-in for define-quick-record mod! sort* sort*! + mod/r! set/r! find-min catch-multiple) #:replace (let* set! define-syntax) @@ -20,6 +21,8 @@ ((_ otherwise ...) ((@ (guile) define-syntax) otherwise ...)))) +(define-public unspecified (if #f #f)) + (define-public upstring->symbol (compose string->symbol string-upcase)) @@ -95,6 +98,9 @@ + + + ;; Replace let* with a version that can bind from lists. ;; Also supports SRFI-71 (extended let-syntax for multiple values) ;; @lisp @@ -164,10 +170,8 @@ ;; Still requires all variables to be defined beforehand. (define-syntax set! (syntax-rules () - ((_ field expr) - (let ((val expr)) - ((@ (guile) set!) field val) - val)) + ((_ field val) + ((@ (guile) set!) field val)) ((_ field val rest ...) (begin ((@ (guile) set!) field val) (set! rest ...))))) @@ -179,9 +183,11 @@ ((_ field proc) (set! field (proc field)))) ) + ;; Like set!, but applies a transformer on the already present value. (define-syntax mod! (syntax-rules (=) + ((_) unspecified) ((_ field = proc) (modf% field = proc)) @@ -194,6 +200,21 @@ ((_ field proc rest ...) (begin (modf% field proc) (mod! rest ...))))) +(define-syntax-rule (set/r! args ... final) + (let ((val final)) + (set! args ... val) + val)) + +(define-syntax mod/r! + (syntax-rules (=) + ((_ args ... field = (proc pargs ...)) + (begin (mod! args ...) + (set/r! field (proc field pargs ...)))) + ((_ args ... ffield fproc) + (begin (mod! args ...) + (set/r! ffield (fproc ffield)))))) + + ;; This function borrowed from web-ics (calendar util) (define* (sort* items comperator #:optional (get identity)) "A sort function more in line with how python's sorted works" |