diff options
Diffstat (limited to 'scheme/idest')
| -rw-r--r-- | scheme/idest/batch/setpic.scm | 24 | ||||
| -rw-r--r-- | scheme/idest/format/pic.scm | 27 | ||||
| -rw-r--r-- | scheme/idest/list-modules.scm | 6 |
3 files changed, 37 insertions, 20 deletions
diff --git a/scheme/idest/batch/setpic.scm b/scheme/idest/batch/setpic.scm index c0670a3..834a571 100644 --- a/scheme/idest/batch/setpic.scm +++ b/scheme/idest/batch/setpic.scm @@ -1,5 +1,5 @@ ;; This file is part of Idest -;; Copyright (C) 2011 Sergey Poznyakoff +;; Copyright (C) 2011, 2015 Sergey Poznyakoff ;; ;; Idest is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -16,7 +16,8 @@ (define-module (idest batch setpic)) -(use-modules (ice-9 getopt-long)) +(use-modules (ice-9 getopt-long) + (rnrs io ports)) (define-public description "set attached picture from a file") @@ -26,17 +27,16 @@ (define (read-picture file) (with-output-to-string (lambda () - (with-input-from-file - file - (lambda () - (let loop ((chr (read-char))) + (let ((port (open-file-input-port file))) + (let ((get-byte (lambda () (get-u8 port)))) + (let loop ((n (get-byte))) (cond - ((not (eof-object? chr)) - (let ((n (char->integer chr))) - (if (< n 16) - (display "0")) - (display (number->string n 16))) - (loop (read-char)))))))))) + ((not (eof-object? n)) + (if (< n 16) + (display "0")) + (display (number->string n 16)) + (loop (get-byte)))))) + (close-port port))))) (define-public (idest-init) (let* ((cmd (command-line)) diff --git a/scheme/idest/format/pic.scm b/scheme/idest/format/pic.scm index 0e42f25..5e831fb 100644 --- a/scheme/idest/format/pic.scm +++ b/scheme/idest/format/pic.scm @@ -1,5 +1,5 @@ ;; This file is part of Idest -;; Copyright (C) 2011 Sergey Poznyakoff +;; Copyright (C) 2011, 2015 Sergey Poznyakoff ;; ;; Idest is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -17,6 +17,7 @@ (define-module (idest format pic)) (use-modules (ice-9 getopt-long) + (rnrs io ports) (srfi srfi-1)) (define-public description @@ -72,11 +73,28 @@ segments)))) (define (save-picture name data) + (let ((port (open-file-output-port name))) + (for-each + (lambda (c) (put-u8 port c)) + (let string->bytelist ((str data) + (bytelist '())) + (cond + ((string-null? str) + (reverse bytelist)) + (else + (string->bytelist + (substring str 2) + (cons + (string->number (substring str 0 2) 16) + bytelist)))))) + (close-port port))) + +(define (save-picture-0 name data) (with-output-to-file name (lambda () (for-each - write-char + (lambda (c) (put-u8 (current-output-port) c)) (let string->bytelist ((str data) (bytelist '())) (cond @@ -86,8 +104,7 @@ (string->bytelist (substring str 2) (cons - (integer->char - (string->number (substring str 0 2) 16)) + (string->number (substring str 0 2) 16) bytelist))))))))) (define-public (idest-init) @@ -204,4 +221,4 @@ (exit 1))))))) pictures)))))))) -
\ No newline at end of file + diff --git a/scheme/idest/list-modules.scm b/scheme/idest/list-modules.scm index c69d331..880dbf8 100644 --- a/scheme/idest/list-modules.scm +++ b/scheme/idest/list-modules.scm @@ -1,5 +1,5 @@ ;; This file is part of Idest -;; Copyright (C) 2011 Sergey Poznyakoff +;; Copyright (C) 2011, 2015 Sergey Poznyakoff ;; ;; Idest is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -92,7 +92,7 @@ (lambda (a b) (string<? (car a) (car b)))))) - ;; Try out each candidate and print ist name, directory and description + ;; Try out each candidate and print its name, directory and description ;; if it happens to be a valid idest format module. ;; Take care not to bail out on errors. Disable %load-hook as it migh ;; clobber the output. @@ -111,7 +111,7 @@ ; Its directory, if required (if print-dir (format #t " (~A)" (cdr candidate))) - ; A colon, and description (if any + ; A colon, and description (if any) (format #t ": ~A~%" (catch #t (lambda () |