server/progs/tools/file.scm

   1
   2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   3 ;;
   4 ;; MODULE      : file.scm
   5 ;; DESCRIPTION : basic routines on files
   6 ;; COPYRIGHT   : (C) 2006  Joris van der Hoeven
   7 ;;
   8 ;; This software falls under the GNU general public license and comes WITHOUT
   9 ;; ANY WARRANTY WHATSOEVER. See the file $TEXMACS_PATH/LICENSE for details.
  10 ;; If you don't have this file, write to the Free Software Foundation, Inc.,
  11 ;; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  12 ;;
  13 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  14
  15 (define-module (tools file))
  16 (use-modules (ice-9 rdelim) (tools base) (tools abbrevs))
  17
  18 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  19 ;; Error handling
  20 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  21
  22 (define-public-macro (ignore-errors type body)
  23   `(catch ,type
  24           (lambda () ,body)
  25           (lambda args #f)))
  26
  27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28 ;; Important directories
  29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  30
  31 (define-public (server-dir)
  32   (let* ((user (cuserid))
  33          (info (getpw user))
  34          (home (passwd:dir info)))
  35     (string-append home "/.texmacsd")))
  36
  37 (define-public (system-dir)
  38   (string-append (server-dir) "/system"))
  39
  40 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  41 ;; Saving and loading
  42 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  43
  44 (define-public (save-string file s)
  45   (display s (open-file file OPEN_WRITE))
  46   (flush-all-ports)
  47   #t)
  48
  49 (define-public (load-string file)
  50   (read-delimited "" (open-file file OPEN_READ)))
  51
  52 (define-public (save-object file value)
  53   (write value (open-file file OPEN_WRITE))
  54   (flush-all-ports))
  55
  56 (define-public (load-object file)
  57   (read (open-file file OPEN_READ)))
  58
  59 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  60 ;; System calls
  61 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  62
  63 (define-public-macro (with-temp-file name s . body)
  64   `(with ,name (string-append (server-dir) "/system/tmpXXXXXX")
  65      (with p (mkstemp! ,name)
  66        (display ,s p)
  67        (flush-all-ports)
  68        (close-port p)
  69        (with r (begin ,@body)
  70          (delete-file ,name)
  71          r))))
  72
  73 (define-public (eval-system cmd)
  74   (let* ((temp-file (string-append (server-dir) "/system/tmpXXXXXX"))
  75          (p (mkstemp! temp-file))
  76          (d1 (close-port p))
  77          (status (system (string-append cmd " > " temp-file)))
  78          (r (if (== status 0) (load-string temp-file) #f))
  79          (d2 (delete-file temp-file)))
  80     r))
  81
  82 (define-public (system* . args)
  83   (system (apply string-append args)))
  84
  85 (define-public (eval-system* . args)
  86   (eval-system (apply string-append args)))