diff --git a/scheme/afs.scm b/scheme/afs.scm new file mode 100644 index 0000000..ea0a725 --- /dev/null +++ b/scheme/afs.scm @@ -0,0 +1,79 @@ + +(define-record-type acl :acl + (make-acl dir afs-perms) + acl? + (dir acl-dir) + (afs-perms acl-afs-perms)) + + +(define (make-header width dir) + (list + (string-append "Access list for " dir " is"))) + +(define (layout-afs-perm width p) + (cut-to-size + width + (string-append + (fill-up-string 20 (car p)) + " " + (afs-permissions->string (cdr p))))) + +(define (make-afs-perms-select-list num-cols num-lines afs-perms) + (make-select-list + (map + (lambda (p) + (make-unmarked-element p #t (layout-afs-perm num-cols p))) + afs-perms) + num-lines)) + + +(define (make-acl-viewer acl buffer) + (let* ((dir (acl-dir acl)) + (afs-perms (acl-afs-perms acl)) + (header (make-header (result-buffer-num-cols buffer) dir)) + (select-list + (make-afs-perms-select-list + (result-buffer-num-cols buffer) + (- (result-buffer-num-lines buffer) (length header)) + afs-perms))) + (lambda (message) + (case message + + ((paint) + (lambda (self win buffer have-focus?) + (let ((hdr-len (length header))) + (for-each (lambda (text y) + (mvwaddstr win y 0 text)) + header + (iota hdr-len)) + (paint-selection-list-at + select-list 0 hdr-len win buffer have-focus?)))) + + ((key-press) + (lambda (self key control-x-pressed?) + (set! select-list + (select-list-handle-key-press select-list key)) + self)) + +; ((get-selection) get-selection) + +; ((get-focus-object) get-focus-object) + + (else + (error "acl viewer unknown message" message)))))) + +(register-plugin! + (make-command-plugin "fs" + (lambda args #f) + (lambda (command args) + (cond + ((or (string=? (car args) "la") + (string=? (car args) "listacl")) + (make-acl (cadr args) + (get-acl (cadr args)))) + (else + (display "unsupported fs command" (car args))))))) + + +(register-plugin! + (make-view-plugin make-acl-viewer acl?)) \ No newline at end of file diff --git a/scheme/go b/scheme/go index 4dfa23a..fbd1b96 100755 --- a/scheme/go +++ b/scheme/go @@ -1,5 +1,5 @@ #!/bin/sh -args="-lel pps/load.scm -lel module-system/load.scm -lel interaction/load.scm -lel cml/load.scm -lm debug-packages.scm -lel scsh-ncurses-0.2/load.scm -lm nuit-packages.scm -o nuit" +args="-lel afs-0.2/load.scm -lel pps/load.scm -lel module-system/load.scm -lel interaction/load.scm -lel cml/load.scm -lm debug-packages.scm -lel scsh-ncurses-0.2/load.scm -lm nuit-packages.scm -o nuit" echo "Starting scsh with options: $args" exec scsh $args #-c "(nuit)" diff --git a/scheme/gogo b/scheme/gogo index 280c9e7..5fc937d 100755 --- a/scheme/gogo +++ b/scheme/gogo @@ -1,3 +1,3 @@ #!/bin/sh -args="-lel pps/load.scm -lel module-system/load.scm -lel interaction/load.scm -lel cml/load.scm -lm debug-packages.scm -lel scsh-ncurses-0.2/load.scm -lm nuit-packages.scm -o nuit" +args="-lel afs/load.scm -lel pps/load.scm -lel module-system/load.scm -lel interaction/load.scm -lel cml/load.scm -lm debug-packages.scm -lel scsh-ncurses-0.2/load.scm -lm nuit-packages.scm -o nuit" exec scsh $args -c "(nuit)" diff --git a/scheme/nuit-packages.scm b/scheme/nuit-packages.scm index 0cfaff4..b603291 100644 --- a/scheme/nuit-packages.scm +++ b/scheme/nuit-packages.scm @@ -152,6 +152,20 @@ tty-debug) (files user-group-info)) +;;; AFS + + +(define-structure afs-plugin (export) + (open scheme-with-scsh + afs-fs + define-record-types + (subset srfi-1 (iota)) + + ncurses + select-list + plugin + layout) + (files afs)) ;;; file list view plugin @@ -558,6 +572,7 @@ joblist-viewer dirlist-view-plugin user-group-info-plugin + afs-plugin process-viewer standard-command-plugin standard-viewer