aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@hornquist.se>2019-04-24 19:40:46 +0200
committerHugo Hörnquist <hugo@hornquist.se>2019-04-24 19:40:53 +0200
commit0f968fcc28bbb48ad0d65938b05bed3d75c7819c (patch)
tree36f9488a7c444d5e2f3fee30fcef11e1e0deddd3
parentAdd overriding define-syntax. (diff)
downloadcalp-0f968fcc28bbb48ad0d65938b05bed3d75c7819c.tar.gz
calp-0f968fcc28bbb48ad0d65938b05bed3d75c7819c.tar.xz
Add {mod,set}/r!
`set!' by default has an unspecified return value. But that haven't stopped me from using that (set! (acc obj) val) returns the value returned by the internal setter function. This change requires you to explicitly request the returning version of set, which returns the value of the last set field.
-rw-r--r--module/output/text.scm4
-rw-r--r--module/util.scm29
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"