scsh-0.6/scsh/signal.scm

55 lines
2.0 KiB
Scheme

;;; Signals (rather incomplete)
;;; ---------------------------
(import-os-error-syscall signal-pid (pid signal) "scsh_kill")
(define (signal-process proc signal)
(signal-pid (cond ((proc? proc) (proc:pid proc))
((integer? proc) proc)
(else (error "Illegal proc passed to signal-process" proc)))
signal))
(define (signal-process-group proc-group signal)
(signal-pid (- (cond ((proc? proc-group) (proc:pid proc-group))
((integer? proc-group) proc-group)
(else (error "Illegal proc passed to signal-process-group"
proc-group))))
signal))
(define (itimer sec)
((structure-ref sigevents schedule-timer-interrupt!) (* sec 1000)))
;;; SunOS, not POSIX:
;;; (define-foreign signal-process-group/errno
;;; (killpg (integer proc-group) (integer signal))
;;; (to-scheme integer errno_or_false))
;;;
;;; (define-errno-syscall (signal-process-group proc-group signal)
;;; signal-process-group/errno)
;;; I do this one in C, I'm not sure why:
;;; It is used by MATCH-FILES.
;;; 99/7: No one is using this function, so I'm commenting it out.
;;; Later, we could tune up the globber or regexp file-matcher to use
;;; it (but should shift it into the rx directory). But I should also go
;;; to a file-at-a-time cursor model for directory fetching. -Olin
;(define-foreign %filter-C-strings!
; (filter_stringvec (string pattern) ((C "char const ** ~a") cvec))
; static-string ; error message -- #f if no error.
; integer) ; number of files that pass the filter.
;(define (match-files regexp . maybe-dir)
; (let ((dir (:optional maybe-dir ".")))
; (check-arg string? dir match-files)
; (receive (err cvec numfiles)
; (%open-dir (ensure-file-name-is-nondirectory dir))
; (if err (errno-error err match-files regexp dir))
; (receive (err numfiles) (%filter-C-strings! regexp cvec)
; (if err (error err match-files))
; (%sort-file-vector cvec numfiles)
; (let ((files (C-string-vec->Scheme&free cvec numfiles)))
; (vector->list files))))))