From fa9b9111f795c2377ac5d338fab4f431fdd44464 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Sun, 17 Feb 2019 09:10:25 -0800 Subject: save-exe: new function. * lisplib.c (save_exe_instantiate, save_exe_set_entries): New static functions. (lisplib_init): Register auto-load of save-exe module, keyed to save-exe symbol. * share/txr/stdlib/save-exe.tl: New file. * txr.1: Removing txr-embedded-arg.txr documentation and documenting save-exe in its place. * txr-embedded-arg.txr: File removed. --- share/txr/stdlib/save-exe.tl | 38 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) create mode 100644 share/txr/stdlib/save-exe.tl (limited to 'share') diff --git a/share/txr/stdlib/save-exe.tl b/share/txr/stdlib/save-exe.tl new file mode 100644 index 00000000..dada28a3 --- /dev/null +++ b/share/txr/stdlib/save-exe.tl @@ -0,0 +1,38 @@ +;; Copyright 2019 +;; 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 save-exe (path string) + (let* ((fbuf (file-get-buf txr-exe-path)) + (bs (make-buf-stream fbuf)) + (pre (progn + (stream-set-prop bs :byte-oriented t) + (scan-until-match #/@\(txr\)/ bs))) + (sbuf (ffi-put string (ffi (zarray 128 char))))) + (unless pre + (throwf 'error "~s: ~a isn't a TXR executable" 'save-txr-exe path)) + (put-buf sbuf 0 bs) + (file-put-buf path fbuf) + (chmod path #o766))) -- cgit v1.2.3