edward

  1;;>| String Procedures
  2;;>
  3;;> Utility procedures which operate on strings.
  4
  5;;> Return true if the given string `str` is the empty string.
  6
  7(define (empty-string? str)
  8  (zero? (string-length str)))
  9
 10;;> Pad given string `str` with given padding string `pad` to `length`.
 11
 12(define (pad-string str pad length)
 13  (if (>= (string-length str) length)
 14    str
 15    (pad-string (string-append pad str) pad length)))
 16
 17;;> Convert string to a human readable representation as mandated
 18;;> by the ed [list command][ed list].
 19;;>
 20;;> [ed list]: https://pubs.opengroup.org/onlinepubs/9699919799/utilities/ed.html#tag_20_38_13_17
 21
 22(define (string->human-readable str)
 23  ;; Length at which lines are folded.
 24  (define fold-length
 25    (let*-values (((padding) 8)
 26                  ((port) (current-output-port))
 27                  ((_ cols) (if (terminal-port? port)
 28                              (terminal-size port)
 29                              (values 0 0))))
 30      (if (> cols padding)
 31        (- cols padding)
 32        72)))
 33
 34  (define (byte->human-readable byte)
 35    (case byte
 36      ;; Mapping according to Table 5-1 in POSIX-1.2008.
 37      ((#x5C) "\\\\")
 38      ((#x07) "\\a")
 39      ((#x08) "\\b")
 40      ((#x0C) "\\f")
 41      ((#x0D) "\\r")
 42      ((#x09) "\\t")
 43      ((#x0B) "\\v")
 44
 45      ;; End of each line shall be marked with a `$` character.
 46      ((#x0A) "$\n")
 47      ;; `$` character within the line should be escaped.
 48      ((#x24) "\\$")
 49
 50      ;; Non-printable characters are represented in octal.
 51      (else
 52        (if (ascii-printable? byte)
 53          (string (integer->char byte))
 54          (string-append "\\" (pad-string (number->string byte 8) "0" 3))))))
 55
 56  ;; Fold lines at fold-length and convert bytes according to procedure above.
 57  (let ((bv (string->utf8 str)))
 58    (fold (lambda (idx out)
 59            (let* ((byte (bytevector-u8-ref bv idx))
 60                   (ret (string-append out (byte->human-readable byte))))
 61              (if (and (not (zero? idx))
 62                       (zero? (modulo idx fold-length)))
 63                (string-append ret "\\\n")
 64                ret)))
 65          "" (iota (bytevector-length bv)))))
 66
 67;;> Join a list of path elements (i.e. strings) using `/` as a path separator.
 68
 69(define (path-join . elems)
 70  (fold-right
 71    (lambda (elem path)
 72      (if (empty-string? path)
 73        elem
 74        (string-append elem "/" path)))
 75    "" elems))
 76
 77;;> Return amount of bytes in a string.
 78
 79(define (count-bytes str)
 80  ;; Technically, we would have to convert the string to a bytevector here and
 81  ;; then count the length of that bytevector to obtain the number of bytes
 82  ;; and not the number of characters. However, CHICKEN 5 is not fully unicode
 83  ;; aware and hence string-length actually counts bytes and not characters.
 84  ;;
 85  ;; Additionally a string->utf8 conversion is very expensive especially when
 86  ;; loading large files using edward. Therefore, ideally, we would obtain the
 87  ;; amount of bytes directly through the read procedure in the future.
 88  (string-length str))
 89
 90;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 91
 92;;>| IO Procedures
 93;;>
 94;;> Procedures which deal with input/output.
 95
 96;;> Write `lines`, i.e. a list of non-newline terminated strings to a
 97;;> given `port`. Returns the amount of bytes written to the port
 98;;> (including any newline characters).
 99
100(define (lines->port lines port)
101  (fold (lambda (line num)
102          (let ((line (string-append line "\n")))
103            (write-string line port)
104            (+ num (count-bytes line))))
105        0 lines))
106
107;;> Read from given `port` as a list of lines. Returns pair of retrieved
108;;> lines and total amount of bytes read from the port (including
109;;> newlines).
110
111(define (port->lines port)
112  (let ((lines (read-lines port)))
113    (cons
114      lines
115      (fold (lambda (l n)
116              ;; +1 for newline stripped by read-lines.
117              ;; XXX: Buggy if last line is not not terminated with \n.
118              (+ 1 n (count-bytes l))) 0 lines))))
119
120;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
121
122;;>| Miscellaneous
123;;>
124;;> Miscellaneous utility procedures.
125
126;;> Syntactic sugar to increment a number by one.
127(define (inc n) (+ n 1))
128;;> Syntactic sugar to decrement a number by one.
129(define (dec n) (- n 1))
130
131;;> Identity function, always returns the given value.
132
133(define (id x) x)
134
135;;> Returns all values of an `alist`, discarding the keys.
136
137(define (alist-values alist)
138  (map cdr alist))
139
140;;> Like `display` but prints multiple objects and adds a trailing newline.
141
142(define (println . objs)
143  (apply fprintln (current-output-port) objs))
144
145;;> Like [println](#println) but allows specification of a custom output `port`.
146
147(define (fprintln port . objs)
148  (for-each (lambda (obj) (display obj port)) objs)
149  (newline port))
150
151;;> Whether the given `integer` does not represent an ASCII control character.
152
153(define (ascii-printable? integer)
154  (and (>= integer #x20) (<= integer #x7e)))
155
156;;> Return path to home directory of current user.
157;;> This procedure emits an error if the environment variable `HOME` is unset.
158
159(define (user-home)
160  (let ((home (get-environment-variable "HOME")))
161    (if home
162      home
163      (error "environment variable 'HOME' not set"))))