Skip to content
Snippets Groups Projects
Commit 3ac32f98 authored by wlott's avatar wlott
Browse files

This commit was generated by cvs2svn to compensate for changes in r4530,

which included commits to RCS files with non-trunk default branches.
parents 11639ee6 202c0bf7
No related branches found
No related tags found
No related merge requests found
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/dired.lisp,v 1.1.1.3 1991/02/08 16:33:47 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/dired.lisp,v 1.1.1.4 1992/02/14 23:50:55 wlott Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -113,7 +113,7 @@
(cond
((not directoryp)
(let* ((ses-name1 (ext:unix-namestring spec1 t))
(exists1p (mach:unix-file-kind ses-name1))
(exists1p (unix:unix-file-kind ses-name1))
(ses-name2 (ext:unix-namestring spec2 nil))
(pname1 (pathname ses-name1))
(pname2 (pathname ses-name2))
......@@ -300,7 +300,7 @@
(cond
((not directoryp)
(let* ((ses-name1 (ext:unix-namestring spec1 t))
(exists1p (mach:unix-file-kind ses-name1))
(exists1p (unix:unix-file-kind ses-name1))
(ses-name2 (ext:unix-namestring spec2 nil))
(pname1 (pathname ses-name1))
(pname2 (pathname ses-name2))
......@@ -554,7 +554,7 @@
(defun make-directory (name)
"Creates directory name. If name exists, then an error is signaled."
(let ((ses-name (ext:unix-namestring name nil)))
(when (mach:unix-file-kind ses-name)
(when (unix:unix-file-kind ses-name)
(funcall *error-function* "Name already exists -- ~S" ses-name))
(enter-directory ses-name))
t)
......@@ -565,23 +565,23 @@
(defun open-file (ses-name)
(multiple-value-bind (fd err)
(mach:unix-open ses-name mach:o_rdonly 0)
(unix:unix-open ses-name unix:o_rdonly 0)
(unless fd
(funcall *error-function* "Opening ~S failed: ~A." ses-name err))
fd))
(defun close-file (fd)
(mach:unix-close fd))
(unix:unix-close fd))
(defun read-file (fd ses-name)
(multiple-value-bind (winp dev-or-err ino mode nlink uid gid rdev size)
(mach:unix-fstat fd)
(unix:unix-fstat fd)
(declare (ignore ino nlink uid gid rdev))
(unless winp (funcall *error-function*
"Opening ~S failed: ~A." ses-name dev-or-err))
(let ((storage (system:allocate-system-memory size)))
(multiple-value-bind (read-bytes err)
(mach:unix-read fd storage size)
(unix:unix-read fd storage size)
(when (or (null read-bytes) (not (= size read-bytes)))
(system:deallocate-system-memory storage size)
(funcall *error-function*
......@@ -589,39 +589,39 @@
(values storage size mode))))
(defun write-file (ses-name data byte-count mode)
(multiple-value-bind (fd err) (mach:unix-creat ses-name #o644)
(multiple-value-bind (fd err) (unix:unix-creat ses-name #o644)
(unless fd
(funcall *error-function* "Couldn't create file ~S: ~A"
ses-name (mach:get-unix-error-msg err)))
(multiple-value-bind (winp err) (mach:unix-write fd data 0 byte-count)
ses-name (unix:get-unix-error-msg err)))
(multiple-value-bind (winp err) (unix:unix-write fd data 0 byte-count)
(unless winp
(funcall *error-function* "Writing file ~S failed: ~A"
ses-name
(mach:get-unix-error-msg err))))
(mach:unix-fchmod fd (logand mode #o777))
(mach:unix-close fd)))
(unix:get-unix-error-msg err))))
(unix:unix-fchmod fd (logand mode #o777))
(unix:unix-close fd)))
(defvar *utimes-buffer* (make-list 4 :initial-element 0))
(defun set-write-date (ses-name secs)
(multiple-value-bind (winp dev-or-err ino mode nlink uid gid rdev size atime)
(mach:unix-stat ses-name)
(unix:unix-stat ses-name)
(declare (ignore ino mode nlink uid gid rdev size))
(unless winp (funcall *error-function*
"Couldn't stat file ~S failed: ~A." ses-name
dev-or-err))
(setf (car *utimes-buffer*) atime)
(setf (caddr *utimes-buffer*) secs))
(multiple-value-bind (winp err) (mach:unix-utimes ses-name *utimes-buffer*)
(multiple-value-bind (winp err) (unix:unix-utimes ses-name *utimes-buffer*)
(unless winp
(funcall *error-function* "Couldn't set write date of file ~S: ~A"
ses-name
(mach:get-unix-error-msg err)))))
(unix:get-unix-error-msg err)))))
(defun get-write-date (ses-name)
(multiple-value-bind (winp dev-or-err ino mode nlink uid gid rdev size
atime mtime)
(mach:unix-stat ses-name)
(unix:unix-stat ses-name)
(declare (ignore ino mode nlink uid gid rdev size atime))
(unless winp (funcall *error-function* "Couldn't stat file ~S failed: ~A."
ses-name dev-or-err))
......@@ -634,13 +634,13 @@
;;; have this problem.
;;;
(defun sub-rename-file (ses-name1 ses-name2)
(multiple-value-bind (res err) (mach:unix-rename ses-name1 ses-name2)
(multiple-value-bind (res err) (unix:unix-rename ses-name1 ses-name2)
(unless res
(funcall *error-function* "Failed to rename ~A to ~A: ~A."
ses-name1 ses-name2 (mach:get-unix-error-msg err)))))
ses-name1 ses-name2 (unix:get-unix-error-msg err)))))
(defun directory-existsp (ses-name)
(eq (mach:unix-file-kind ses-name) :directory))
(eq (unix:unix-file-kind ses-name) :directory))
(defun enter-directory (ses-name)
(declare (simple-string ses-name))
......@@ -649,21 +649,21 @@
length-1)
(subseq ses-name 0 (1- (length ses-name)))
ses-name)))
(multiple-value-bind (winp err) (mach:unix-mkdir name #o755)
(multiple-value-bind (winp err) (unix:unix-mkdir name #o755)
(unless winp
(funcall *error-function* "Couldn't make directory ~S: ~A"
name
(mach:get-unix-error-msg err))))))
(unix:get-unix-error-msg err))))))
(defun delete-directory (ses-name)
(declare (simple-string ses-name))
(multiple-value-bind (winp err)
(mach:unix-rmdir (subseq ses-name 0
(unix:unix-rmdir (subseq ses-name 0
(1- (length ses-name))))
(unless winp
(funcall *error-function* "Couldn't delete directory ~S: ~A"
ses-name
(mach:get-unix-error-msg err)))))
(unix:get-unix-error-msg err)))))
......
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/spell-rt.lisp,v 1.1.1.3 1991/02/08 16:37:56 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/spell-rt.lisp,v 1.1.1.4 1992/02/14 23:51:14 wlott Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -76,23 +76,23 @@
(defun open-dictionary (f)
(let* ((filename (ext:unix-namestring f))
(kind (mach:unix-file-kind filename)))
(kind (unix:unix-file-kind filename)))
(unless kind (error "Cannot find dictionary -- ~S." filename))
(multiple-value-bind (fd err)
(mach:unix-open filename mach:o_rdonly 0)
(unix:unix-open filename unix:o_rdonly 0)
(unless fd
(error "Opening ~S failed: ~A." filename err))
(multiple-value-bind (winp dev-or-err) (mach:unix-fstat fd)
(multiple-value-bind (winp dev-or-err) (unix:unix-fstat fd)
(unless winp (error "Opening ~S failed: ~A." filename dev-or-err))
fd))))
(defun close-dictionary (fd)
(mach:unix-close fd))
(unix:unix-close fd))
(defun read-dictionary-structure (fd bytes)
(let* ((structure (allocate-bytes bytes)))
(multiple-value-bind (read-bytes err)
(mach:unix-read fd structure bytes)
(unix:unix-read fd structure bytes)
(when (or (null read-bytes) (not (= bytes read-bytes)))
(deallocate-bytes (system-address structure) bytes)
(error "Reading dictionary structure failed: ~A." err))
......
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/tty-disp-rt.lisp,v 1.1.1.4 1991/09/03 16:26:06 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/tty-disp-rt.lisp,v 1.1.1.5 1992/02/14 23:51:16 wlott Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -52,9 +52,6 @@
(defvar *terminal-baud-rate* nil)
(declaim (type (or (unsigned-byte 16) null) *terminal-baud-rate*))
(defalien sgtty mach:sgtty (record-size 'mach:sgtty))
(defalien winsize mach:winsize (record-size 'mach:winsize))
;;; GET-TERMINAL-ATTRIBUTES -- Interface
;;;
;;; Get terminal attributes from Unix. Return as values, the lines,
......@@ -65,21 +62,21 @@
;;; the buffer is in a global.
;;;
(defun get-terminal-attributes (&optional (fd 1))
(mach::with-trap-arg-block mach:winsize winsize
(mach::with-trap-arg-block mach:sgtty sgtty
(let ((size-win (mach:unix-ioctl fd mach:TIOCGWINSZ (alien-sap winsize)))
(speed-win (mach:unix-ioctl fd mach:TIOCGETP (alien-sap sgtty))))
(flet ((frob (val)
(if (and size-win (not (zerop val)))
val
nil)))
(values
(frob (alien-access (mach:winsize-ws_row winsize)))
(frob (alien-access (mach:winsize-ws_col winsize)))
(and speed-win
(setq *terminal-baud-rate*
(svref mach:terminal-speeds
(alien-access (mach:sgtty-ospeed sgtty)))))))))))
(alien:with-alien ((winsize (alien:struct unix:winsize))
(sgtty (alien:struct unix:sgttyb)))
(let ((size-win (unix:unix-ioctl fd mach:TIOCGWINSZ (alien-sap winsize)))
(speed-win (unix:unix-ioctl fd mach:TIOCGETP (alien-sap sgtty))))
(flet ((frob (val)
(if (and size-win (not (zerop val)))
val
nil)))
(values
(frob (alien:slot winsize 'unix:ws-row))
(frob (alien:slot winsize 'unix:ws-col))
(and speed-win
(setq *terminal-baud-rate*
(svref unix:terminal-speeds
(alien:slot sgtty 'unix:sg-ospeed)))))))))
;;;; Output routines and buffering.
......@@ -102,7 +99,7 @@
;;;
(defun write-and-maybe-wait (count)
(declare (fixnum count))
(mach:unix-write 1 *redisplay-output-buffer* 0 count)
(unix:unix-write 1 *redisplay-output-buffer* 0 count)
(let ((speed *terminal-baud-rate*))
(when speed
(sleep (/ (* (float count) 10.0) (float speed))))))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment