55 lines
2.0 KiB
Scheme
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))))))
|