/[meta-cvs]/meta-cvs/F-6BD7679FED76D6E5A7D36DC36C205FC1.lisp
ViewVC logotype

Diff of /meta-cvs/F-6BD7679FED76D6E5A7D36DC36C205FC1.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.9 by kaz, Sun Oct 6 05:19:54 2002 UTC revision 1.9.2.6 by kaz, Thu Jan 30 11:04:43 2003 UTC
# Line 2  Line 2 
2  ;;; which is distributed under the GNU license.  ;;; which is distributed under the GNU license.
3  ;;; Copyright 2002 Kaz Kylheku  ;;; Copyright 2002 Kaz Kylheku
4    
5    (require "chatter.lisp")
6    (require "posix")
7  (provide "clisp-unix")  (provide "clisp-unix")
8    
9  ;;; Null pointer handling  ;;; Null pointer handling
# Line 67  Line 69 
69      ((null-to-nil (unix-funcs:opendir dir)))      ((null-to-nil (unix-funcs:opendir dir)))
70      (t (error (make-condition 'open-dir-error :dir dir)))))      (t (error (make-condition 'open-dir-error :dir dir)))))
71    
72    (declaim (inline closedir))
73  (defun closedir (dir-stream)  (defun closedir (dir-stream)
74    (when-not-null dir-stream (unix-funcs:closedir dir-stream)))    (when-not-null dir-stream (unix-funcs:closedir dir-stream)))
75    
 (declaim (inline closedir))  
76    
77  (defun readdir (dir-stream)  (defun readdir (dir-stream)
78    (let ((dir-entry (unix-funcs:readdir dir-stream)))    (let ((dir-entry (unix-funcs:readdir dir-stream)))
# Line 104  Line 106 
106                             :dir (format nil "[file descriptor ~a]" descr))))                             :dir (format nil "[file descriptor ~a]" descr))))
107      (values))      (values))
108    
109  (defun getcwd ()  (define-condition getcwd-error (system-error) ())
110    (unix-funcs:getcwd))  
111    (defmethod initialize-instance :after ((c getcwd-error) &rest args)
112      (declare (ignore args))
113      (with-slots (message) c
114        (setf message (format nil "Unable to determine current directory: ~A."
115                              (unix-funcs:strerror unix-funcs:errno)))))
116    
117  (declaim (inline getcwd))  (declaim (inline getcwd))
118    (defun getcwd ()
119      (or (unix-funcs:getcwd)
120          (error (make-condition 'getcwd-error))))
121    
122  (defmacro current-dir-restore (&body forms)  (defmacro current-dir-restore (&body forms)
123    (let ((saved-dir (gensym "SAVED-DIR-")))    (let ((saved-dir (gensym "SAVED-DIR-")))
# Line 319  Line 330 
330    
331  ;;; Coprocesses  ;;; Coprocesses
332    
 (defconstant *argument-limit* (* 64 1024))  
   
333  (defun shell-interpreter (command)  (defun shell-interpreter (command)
334    (case (shell command)    (case (shell command)
335      ((0) T)      ((0) T)
336      (otherwise nil)))      (otherwise nil)))
337    
338  (defun execute-program (arglist)  (defun execute-program (arglist)
339    (case (run-program (first arglist) :arguments (rest arglist))    (chatter-debug "invoking ~s in directory ~s~%" arglist (getcwd))
340      ((0) T)    (case (unix-funcs:run-program (first arglist) :arguments (rest arglist))
341      (otherwise nil)))      ((0) (chatter-debug "successful termination~%") T)
342        (otherwise (chatter-debug "unsuccessful or abnormal termination~%") nil)))
343    
344  (defmacro with-input-from-program ((stream-var arg-list) &body forms)  (defmacro with-input-from-program ((stream-var arg-list) &body forms)
345   `(let* ((,stream-var (make-pipe-input-stream   `(let* ((,stream-var (make-pipe-input-stream

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.9.2.6

  ViewVC Help
Powered by ViewVC 1.1.5