[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Displaying Unix file information in DIRED
Date: Fri, 20 Jul 90 21:07 PDT
From: snicoud@atc.boeing.com (Stephen L. Nicoud)
Is there a way to modify Zmacs' DIRED so that it displays the
protections,
This is easy, since FS:DIRECTORY-LIST already returns a :PROTECTION
field (at least for FTP, I don't have an NFS host to try it on). All
that is necessary is to modify the file lister to print it (code example
provided below). Any other information that is returned in the property
list is similarly a snap to add (I have a private patch that returns the
LMFS partition id, for example).
group ownership
This is currently not returned by FS:DIRECTORY-LIST (via FTP, again I
can't test NFS). This is because we don't parse it in the FTP response
to a LIST command; I've been told that there is a great variability in
what comes back from various hosts' FTP servers since the format is
intended to be viewed by humans instead of programs. The comments in the
source code for the Unix directory list parser indicate
that the group field is only present sometimes, but assuming you deal only
with hosts that provide it, I've also included the trivial change below.
It took a total of about 5 minutes to find which functions to modify on
my machine, and probably another 5-10 minutes to modify them and test
them. I'm curious why you decided to ask SLUG rather than investigating
on your own; inside of Symbolics we feel that one of the major
advantages of Genera is that you can easily answer these types of
questions and easily make these types of changes (much more easily than
on other platforms in my personal opinion). If we aren't getting that
message across (or aren't documenting how to go about doing it) I feel
it is a major failing on our part.
and any other information it can
determine of UNIX files (ideally under both FTP and NFS)?
The directory file lister is called via a hook, you can replace it completely
with your own; if you want to return absolutely every property that
FS:DIRECTORY-LIST returns, you could invent a keyword=value type format
for printing it. The philosophy of the current lister appears to be to
keep the conceptual clutter low by only including 'generic' information
in a fixed place. Each to his own taste.
Steve
--
Stephen L. Nicoud <snicoud@atc.boeing.com> uw-beaver!bcsaic!snicoud
Boeing Advanced Technology Center for Computer Sciences
The following is a patch file incorporating the changes (highlighted in bold)
into the 7.4 sources. If you have a later release, you should make the same
changes to the later sources (I believe each of the two functions has been
modified slightly in later releases but I might be wrong).
;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: USER; Base: 10; Patch-File: T -*-
;;; Patch file for Private version 0.0
;;; Reason: Function (FLAVOR:METHOD :PARSE-DIRECTORY-RESPONSE FS:UNIX-TCP-FTP-FILE-ACCESS-PATH): parse group field
;;; Function ZWEI:DEFAULT-LIST-ONE-FILE: print protection and group if present
;;; Written by Reti, 7/21/90 12:32:18
;;; while running on Crab Apple from FEP0:>Inc-418-177-from-Inc418-177--etc.ilod.1
;;; with Genera 7.4 Ivory, System 418.177, Logical Pathnames Translation Files NEWEST,
;;; RPC 407.10, MacIvory Support 412.40, Serial 402.15, Utilities 412.26,
;;; Server Utilities 410.2, Hardcopy 413.7, Zmail 410.8, LMFS 411.10, Tape 412.13,
;;; Nsage 407.7, RPC Development 401.4, MacIvory Development 401.5,
;;; Documentation Database 412.5, IP-TCP 413.6, Experimental IFEP Compiler 46.1,
;;; Ivory Revision 1 (FPA enabled), FEP 317, FEP0:>I317-loaders.flod(4),
;;; FEP0:>I317-info.flod(4), FEP0:>I317-debug.flod(4), FEP0:>I317-lisp.flod(4),
;;; FEP0:>i317-kernel.fep(6), Boot PROM version 302, Genera application 3.3.3,
;;; MacOS 6.0.2, 1152x802 Screen with Genera fonts, Machine serial number 353,
;;; Add option for 8-bit binary copy to Dired C command (from G:>Reti>weser>Reti>dired-copy-patch).
(SYSTEM-INTERNALS:FILES-PATCHED-IN-THIS-PATCH-FILE
"SYS:CP;FILE-COMMANDS.LISP.137"
"SYS:IP-TCP;TCP-FTP.LISP.2034")
(NOTE-PRIVATE-PATCH "changes to Dired in answer to Nicoud question")
;=====================================
(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION)
(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "SYS:IP-TCP;TCP-FTP.LISP.2034")
(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES
"-*- Mode: Lisp; Syntax: Common-Lisp; Package: FILE-SYSTEM; Base: 10; Lowercase: Yes -*-")
(defmethod (:parse-directory-response unix-tcp-ftp-file-access-path) (line pathname dir-cmd)
(selector dir-cmd string-equal
("NLST"
(list* (tcp-ftp-parse-truename line pathname) nil))
("LIST"
(when (plusp (string-length line)) 1;skip empty lines (/**/* example)
0 (let ((tokens (loop with length = (string-length line)
for i first 0 then k
for j = (or (string-search-char #\space line i) length)
for k = (string-search-not-char #\space line (1+ j))
collect (substring line i j)
while k))
name
(plist nil))
(macrolet ((add-property (prop val)
`(progn (push ,val plist)
(push ,prop plist))))
(when (mem #'char-equal (aref (first tokens) 0) '(#\d #\l #\-))
;; Protection
(let ((prot (pop tokens)))
(when (char-equal (aref prot 0) #\d)
(add-property :directory t))
(add-property :protection (substring prot 1)))
;; Unit number?
(pop tokens)
;; Author
(add-property :author (pop tokens))
2 ;; Group
(add-property :group (pop tokens))
0 ;; Group (sometimes) -- look ahead for month name
(loop until (ass #'string-equal (second tokens) time:*month-symbols*)
do (pop tokens))
;; Length
(add-property :length-in-bytes (parse-number (pop tokens) 0 nil 10 t))
(add-property :byte-size 8)
;; Date
(let ((month (pop tokens))
(day (pop tokens))
(year (pop tokens)))
(add-property :creation-date (parse-unix-date month day year)))
;; Name
(setf name (tcp-ftp-parse-truename (pop tokens) pathname))
;; Link
(when tokens
(when (string-equal (pop tokens) "->")
(add-property :link-to (tcp-ftp-parse-truename (pop tokens) pathname))))
;; All done
(list* name plist))))))))
;=====================================
(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION)
(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "SYS:CP;FILE-COMMANDS.LISP.137")
(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES
"-*- Syntax: Zetalisp; Mode: LISP; Package: SYSTEM-INTERNALS; Base: 8; Lowercase: T -*-")
;;; Note that *DIRECTORY-SINGLE-FILE-LISTER* is expected to output lines.
;;; If STREAM is NIL, just return the string which would be :LINE-OUT'd.
(defun zwei:default-list-one-file (file &optional (stream standard-output) sensitive-output-p
&aux pathname line dir-p)
(setq line (make-array 400 ':type 'art-fat-string
':leader-length (and (or (null stream)
(and (flavor:find-flavor
'zwei:interval-stream nil)
(typep stream
'zwei:interval-stream)))
zwei:line-leader-size)
':fill-pointer 2))
(si:fill-array line nil #\sp)
(cond ((null (setq pathname (car file)))
(cond ((get file ':disk-space-description)
(string-nconc line (get file ':disk-space-description)))
((get file ':physical-volume-free-blocks)
(do ((free (get file ':physical-volume-free-blocks) (cdr free))
(flag t nil))
((null free))
(string-nconc line (if flag "Free: #" ", #") (caar free) #/=)
(setf (fill-pointer line)
(number-into-array line (cdar free) 10. (fill-pointer line)))))))
(t (if (get file ':deleted) (aset #/D line 0))
(when (get file ':open-for-writing)
(aset #/W line 1)
(setf (fill-pointer line) 3))
(string-nconc line (or (get file ':physical-volume) ""))
(setf (fill-pointer line) (1+ (max 5 (fill-pointer line))))
(setq dir-p (get file ':directory))
(string-nconc line (funcall pathname ':string-for-dired))
(setf (fill-pointer line) (max 20. (1+ (fill-pointer line))))
(let ((link-to (get file ':link-to)))
(cond (link-to
(string-nconc line "=> " link-to)
(setf (fill-pointer line) (max 40. (1+ (fill-pointer line)))))
(t
(if (get file ':offline) ;Tops-20
(string-nconc line "[OFFLINE]")
(let ((length (get file ':length-in-blocks)))
(if length
(setf (fill-pointer line)
(1+ (number-into-array line length 10.
(fill-pointer line) 4)))
(incf (fill-pointer line) 5))))
(if dir-p
(string-nconc line " DIRECTORY")
(let ((length (get file ':length-in-bytes)))
(when length
(setf (fill-pointer line)
(number-into-array line length 10. (fill-pointer line) 6))
(array-push line #/()
(setf (fill-pointer line)
(number-into-array line (get file ':byte-size) 10.
(fill-pointer line)))
(array-push line #/)))))
(setf (fill-pointer line)
(max 39. (1+ (fill-pointer line))))
(array-push line (if (get file ':not-backed-up) #/! #\sp)))))
(array-push line (if (get file ':dont-delete) #/@ #\sp))
(array-push line (if (get file ':dont-supersede) #/# #\sp))
(array-push line (if (get file ':dont-reap) #/$ #\sp))
(let ((creation-date (or (get file ':creation-date)
(get file ':file-creation-date))))
(if creation-date
(zwei:time-into-array line creation-date)
(incf (fill-pointer line) 17.)))
(let* ((date-last-expunged (get file ':date-last-expunged))
(reference-date (or date-last-expunged (get file ':reference-date))))
(if (null reference-date)
(let ((comment (get file ':comment)))
(if (null comment)
(incf (fill-pointer line) 11.)
(string-nconc line " [" comment "]")))
(string-nconc line (if date-last-expunged " X=" " ("))
(zwei:time-into-array line reference-date nil)
(or date-last-expunged (array-push line #/)))))
2(let ((protection (get file :protection)))
(when (and protection (stringp protection))
(array-push line #/ )
(loop for char being array-elements of protection
do (array-push line char))))
(let ((group (get file :group)))
(when (and group (stringp group))
(array-push line #/ )
(loop for char being array-elements of group
do (array-push line char))))
0 (let ((directory (send pathname ':raw-directory)))
(when (and (listp directory)
(null (cdr directory)))
(setq directory (car directory)))
(let ((author (get file ':author)))
(when (and author (not (equal directory author)))
(setf (fill-pointer line)
(max (1+ (fill-pointer line)) 74.))
(string-nconc line author)))
(let ((reader (get file ':reader)))
(when (and reader (not (equal reader directory)))
(setf (fill-pointer line)
(max (1+ (fill-pointer line)) 84.))
(string-nconc line reader))))))
(adjust-array-size line (fill-pointer line))
(unless (null stream)
(if (or (null pathname) (null sensitive-output-p))
(send stream ':line-out line)
(dw:with-output-as-presentation (:stream stream :type 'fs:pathname :object pathname)
(send stream :line-out line))))
line)