From e98737b05917ebeaad6a8868e8d4d3cc6e5a89b2 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Sun, 13 Nov 2016 19:20:39 -0800 Subject: New functions for command or file I/O in one call. * lisplib.c (getput_set_entries, getput_instantiate): New static functions. (dlt_register): Register auto-loading for getput module via new functions. * share/txr/stdlib/getput.tl: New file. * txr.1: Documented new functions file-get, file-put, file-append, file-get-string, file-put-string, file-append-string, file-get-lines, file-put-lines, file-append-lines, command-get, command-put, command-get-string, command-put-string, command-get-lines, and command-put-lines. --- lisplib.c | 22 +++++ share/txr/stdlib/getput.tl | 83 +++++++++++++++++++ txr.1 | 196 +++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 301 insertions(+) create mode 100644 share/txr/stdlib/getput.tl diff --git a/lisplib.c b/lisplib.c index 06178383..38c002ce 100644 --- a/lisplib.c +++ b/lisplib.c @@ -424,6 +424,27 @@ static val package_instantiate(val set_fun) return nil; } +static val getput_set_entries(val dlt, val fun) +{ + val name[] = { + lit("file-get"), lit("file-put"), lit("file-append"), + lit("file-get-string"), lit("file-put-string"), lit("file-append-string"), + lit("file-get-lines"), lit("file-put-lines"), lit("file-append-lines"), + lit("command-get"), lit("command-put"), + lit("command-get-string"), lit("command-put-string"), + lit("command-get-lines"), lit("command-put-lines"), + nil + }; + set_dlt_entries(dlt, name, fun); + return nil; +} + +static val getput_instantiate(val set_fun) +{ + funcall1(set_fun, nil); + load(format(nil, lit("~agetput.tl"), stdlib_path, nao)); + return nil; +} val dlt_register(val dlt, val (*instantiate)(val), @@ -459,6 +480,7 @@ void lisplib_init(void) dlt_register(dl_table, trace_instantiate, trace_set_entries); dlt_register(dl_table, getopts_instantiate, getopts_set_entries); dlt_register(dl_table, package_instantiate, package_set_entries); + dlt_register(dl_table, getput_instantiate, getput_set_entries); } val lisplib_try_load(val sym) diff --git a/share/txr/stdlib/getput.tl b/share/txr/stdlib/getput.tl new file mode 100644 index 00000000..9db13b78 --- /dev/null +++ b/share/txr/stdlib/getput.tl @@ -0,0 +1,83 @@ +;; Copyright 2016 +;; Kaz Kylheku +;; Vancouver, Canada +;; All rights reserved. +;; +;; Redistribution and use in source and binary forms, with or without +;; modification, are permitted provided that the following conditions are met: +;; +;; 1. Redistributions of source code must retain the above copyright notice, this +;; list of conditions and the following disclaimer. +;; +;; 2. Redistributions in binary form must reproduce the above copyright notice, +;; this list of conditions and the following disclaimer in the documentation +;; and/or other materials provided with the distribution. +;; +;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(defun file-get (name) + (with-stream (s (open-file name)) + (read s))) + +(defun file-put (name obj) + (with-stream (s (open-file name "w")) + (prinl obj s))) + +(defun file-append (name obj) + (with-stream (s (open-file name "a")) + (prinl obj s))) + +(defun file-get-string (name) + (with-stream (s (open-file name)) + (get-string s))) + +(defun file-put-string (name string) + (with-stream (s (open-file name "w")) + (put-string string s))) + +(defun file-append-string (name string) + (with-stream (s (open-file name "a")) + (put-string string s))) + +(defun file-get-lines (name) + (get-lines (open-file name))) + +(defun file-put-lines (name lines) + (with-stream (s (open-file name "w")) + (put-lines lines s))) + +(defun file-append-lines (name lines) + (with-stream (s (open-file name "a")) + (put-lines lines s))) + +(defun command-get (cmd) + (with-stream (s (open-command cmd)) + (read s))) + +(defun command-put (cmd obj) + (with-stream (s (open-command cmd "w")) + (prinl obj s))) + +(defun command-get-string (cmd) + (with-stream (s (open-command cmd)) + (get-string s))) + +(defun command-put-string (cmd string) + (with-stream (s (open-command cmd "w")) + (put-string string s))) + +(defun command-get-lines (cmd) + (get-lines (open-command cmd))) + +(defun command-put-lines (cmd lines) + (with-stream (s (open-command cmd "w")) + (put-lines lines s))) diff --git a/txr.1 b/txr.1 index 77a6f753..2b777943 100644 --- a/txr.1 +++ b/txr.1 @@ -38783,6 +38783,202 @@ situation also. If a coprocess terminates abnormally or unsuccessfully, an exception is raised. +.SS* I/O-Related Convenience Functions + +The functions in this group create a stream, perform an I/O operation +on it, and ensure that it is closed, in one convenient operation. They +operate on files or command streams. + +.coNP Functions @, file-get @ file-get-string and @ file-get-lines +.synb +.mets (file-get << name ) +.mets (file-get-string << name ) +.mets (file-get-lines << name ) +.syne +.desc +The +.code file-get +function opens a text stream over the file indicated by the string argument +.meta name +for reading, reads the printed representation of a \*(TL object from it, +and returns that object, ensuring that the stream is closed. + +The +.code file-get-string +is similar to +.code file-get +except that it reads the entire file as a text stream and returns +its contents in a single character string. + +The +.code file-get-lines +function opens a text stream over the file indicated by +.meta name +and returns produces a lazy list of strings representing the lines +of text of that file as if by a call to the +.code get-lines +function, and returns that list. The stream remains open until the +list is consumed to the end, as indicated in the description of +.codn get-lines . + +.coNP Functions @, file-put @ file-put-string and @ file-put-lines +.synb +.mets (file-put < name << obj ) +.mets (file-put-string < name << string ) +.mets (file-put-lines < name << list ) +.syne +.desc +The +.codn file-put , +.code file-put-string +and +.code file-put-lines +functions open a text stream over the file indicated by the string argument +.metn name , +write the argument object into the file in their specific manner, +and then close the file. + +If the file doesn't exist, it is created. +If it exists, it is truncated to zero length and overwritten. + +The +.code file-put +function writes a printed representation of +.meta obj +using the +.code prinl +function. The return value is that of +.codn prinl . + +The +.code file-put-string +function writes +.meta string +to the stream using the +.code put-string +function. The return value is that of +.codn put-string . + +The +.code file-put-lines +function writes +.meta list +to the stream using the +.code put-lines +function. The return value is that of +.codn put-lines . + +.coNP Functions @, file-append @ file-append-string and @ file-append-lines +.synb +.mets (file-append < name << obj ) +.mets (file-append-string < name << string ) +.mets (file-append-lines < name << list ) +.syne +.desc +The +.codn file-append , +.code file-append-string +and +.code file-append-lines +functions open a text stream over the file indicated by the string argument +.metn name , +write the argument object into the stream in their specific manner, +and then close the stream. + +These functions are close counterparts of, respectively, +.codn file-get , +.code file-append-string +and +.codn file-append-lines . + +These functions behave differently when the indicated file +already exists. Rather than being truncated and overwritten, +the file is extended by appending the new data to its end. + +.coNP Functions @, command-get @ command-get-string and @ command-get-lines +.synb +.mets (command-get << cmd ) +.mets (command-get-string << cmd ) +.mets (command-get-lines << cmd ) +.syne +.desc +The +.code command-get +function opens text stream over an input command pipe created for +the command string +.metn cmd , +as if by the +.code open-command +function. It reads the printed representation of a \*(TL object from it, and +returns that object, ensuring that the stream is closed. + +The +.code command-get-string +is similar to +.code command-get +except that it reads the entire file as a text stream and returns +its contents in a single character string. + +The +.code command-get-lines +function opens a text stream over an input command pipe created for the +command string +.meta cmd +and returns produces a lazy list of strings representing the lines +of text of that file as if by a call to the +.code get-lines +function, and returns that list. The stream remains open until the +list is consumed to the end, as indicated in the description of +.codn get-lines . + +.coNP Functions @, command-put @ command-put-string and @ command-put-lines +.synb +.mets (command-put < cmd << obj ) +.mets (command-put-string < cmd << string ) +.mets (command-put-lines < cmd << list ) +.syne +.desc +The +.codn command-put , +.code command-put-string +and +.code command-put-lines +functions open an output text stream over an output command pipe created +for the command specified in the string argument +.metn cmd , +as if by the +.code open-command +function. +They write the argument object into the stream in their specific manner, +and then close the stream. + +The +.code command-put +function writes a printed representation of +.meta obj +using the +.code prinl +function. The return value is that of +.codn prinl . + +The +.code command-put-string +function writes +.meta string +to the stream using the +.code put-string +function. The return value is that of +.codn put-string . + +The +.code command-put-lines +function writes +.meta list +to the stream using the +.code put-lines +function. The return value is that of +.codn put-lines . + .SS* Symbols and Packages \*(TL has a package system inspired by the salient features of ANSI Common Lisp, but substantially simpler. -- cgit v1.2.3