/[guile]/guile/guile-core/lang/elisp/internals/format.scm
ViewVC logotype

Diff of /guile/guile-core/lang/elisp/internals/format.scm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by ossau, Fri Oct 26 16:42:43 2001 UTC revision 1.2 by ossau, Tue Jan 22 23:46:01 2002 UTC
# Line 0  Line 1 
1    (define-module (lang elisp internals format)
2      #:pure
3      #:use-module (ice-9 r5rs)
4      #:use-module ((ice-9 format) #:select ((format . scheme:format)))
5      #:use-module (lang elisp internals fset)
6      #:use-module (lang elisp internals signal)
7      #:export (format
8                message))
9    
10    (define (format control-string . args)
11    
12      (define (cons-string str ls)
13        (let loop ((sl (string->list str))
14                   (ls ls))
15          (if (null? sl)
16              ls
17              (loop (cdr sl) (cons (car sl) ls)))))
18    
19      (let loop ((input (string->list control-string))
20                 (args args)
21                 (output '())
22                 (mid-control #f))
23        (if (null? input)
24            (if mid-control
25                (error "Format string ends in middle of format specifier")
26                (list->string (reverse output)))
27            (if mid-control
28                (case (car input)
29                  ((#\%)
30                   (loop (cdr input)
31                         args
32                         (cons #\% output)
33                         #f))
34                  (else
35                   (loop (cdr input)
36                         (cdr args)
37                         (cons-string (case (car input)
38                                        ((#\s) (scheme:format #f "~A" (car args)))
39                                        ((#\d) (number->string (car args)))
40                                        ((#\o) (number->string (car args) 8))
41                                        ((#\x) (number->string (car args) 16))
42                                        ((#\e) (number->string (car args))) ;FIXME
43                                        ((#\f) (number->string (car args))) ;FIXME
44                                        ((#\g) (number->string (car args))) ;FIXME
45                                        ((#\c) (let ((a (car args)))
46                                                 (if (char? a)
47                                                     (string a)
48                                                     (string (integer->char a)))))
49                                        ((#\S) (scheme:format #f "~S" (car args)))
50                                        (else
51                                         (error "Invalid format operation %%%c" (car input))))
52                                      output)
53                         #f)))
54                (case (car input)
55                  ((#\%)
56                   (loop (cdr input) args output #t))
57                  (else
58                   (loop (cdr input) args (cons (car input) output) #f)))))))
59    
60    (define (message control-string . args)
61      (display (apply format control-string args))
62      (newline))

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26