andrius
/
gash
mirror of https://git.savannah.gnu.org/git/gash.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

compress WIP

This commit is contained in:
Jan Nieuwenhuizen 2018-11-04 19:33:52 +01:00
parent 9cf3ee9e7e
commit a8a6ea06df
1 changed files with 6 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gash/compress.scm
View File

@ -41,7 +41,7 @@
(define *program-name* "compress (GASH)")
(define (_ msg . rest)
(cons msg rest))
msg)
(define (error* status msg . args)
(force-output)
@ -79,6 +79,8 @@
(put-bytevector port (u8-list->bytevector (list #x1F #x9D bits))))
(define (compress-port in out bits verbose?)
(set-port-encoding! in "ISO-8859-1")
(set-port-encoding! out "ISO-8859-1")
#;
(begin
(write-lzw-header out bits)
@ -101,7 +103,7 @@
(error* 1 (_ "~a: already exists") outfile))
(let ((in (open-file infile "rb"))
(out (open-file outfile "wb")))
;; TODO: Keep original files ownership, modes, and access
;; TODO: Keep original files ownership, modes, and access
;; and modification times.
(compress-port in out bits verbose?)
(when verbose?
@ -123,6 +125,8 @@
(x #f)))
(define (uncompress-port in out verbose?)
(set-port-encoding! in "ISO-8859-1")
(set-port-encoding! out "ISO-8859-1")
(let ((bits (read-lzw-header in)))
(unless bits
(error* 1 (_ "incorrect header")))