diff --git a/scheme/nuit-packages.scm b/scheme/nuit-packages.scm index 59b9503..f80dadc 100644 --- a/scheme/nuit-packages.scm +++ b/scheme/nuit-packages.scm @@ -86,6 +86,20 @@ tty-debug) (files process)) +;;; user/group viewer plugin + +(define-structure user-group-info-plugin (export) + (open scheme-with-scsh + define-record-types + (subset primitives (record-ref record?)) + + plugin + layout + select-list + tty-debug) + (files user-group-info)) + + ;;; file list view plugin (define-structure dirlist-view-plugin (export) @@ -124,6 +138,7 @@ (export make-standard-viewer) (open scheme + tty-debug objects layout) (files std-viewer)) @@ -326,6 +341,7 @@ select-list ;; the following modules are plugins dirlist-view-plugin + user-group-info-plugin process-viewer standard-command-plugin standard-viewer diff --git a/scheme/user-group-info.scm b/scheme/user-group-info.scm new file mode 100644 index 0000000..4ff1103 --- /dev/null +++ b/scheme/user-group-info.scm @@ -0,0 +1,53 @@ +(define (make-ui-select-list ui num-lines) + (make-select-list + (list (make-unmarked-element (user-info:name ui) + #t + (user-info:name ui)) + (make-unmarked-element (user-info:uid ui) + #t + (number->string (user-info:uid ui))) + (make-unmarked-element (user-info:gid ui) + #t + (number->string (user-info:gid ui))) + (make-unmarked-element (user-info:home-dir ui) + #t + (user-info:home-dir ui)) + (make-unmarked-element (user-info:shell ui) + #t + (user-info:shell ui))) + num-lines)) + +(define (make-user-info-browser ui buffer) + (let ((ui ui) + (buffer buffer) + (selection-list + (make-ui-select-list ui (result-buffer-num-lines buffer)))) + (lambda (message) + (case message + ((paint) + (lambda (self . args) + (apply paint-selection-list + selection-list args))) + ((key-press) + (lambda (self key control-x-pressed?) + (set! selection-list + (select-list-handle-key-press + selection-list key)) + self)) + (else + (error "unknown message in make-user-info-browser" message)))))) + + +;; scsh fails to export user-info? and group-info?... +(define user-info-type (record-ref (user-info 0) 0)) +(define (user-info? x) + (and (record? x) + (eq? (record-ref x 0) user-info-type))) + +(define group-info-type (record-ref (group-info 0) 0)) +(define (group-info? x) + (and (record? x) + (eq? (record-ref x 0) group-info-type))) + +(register-plugin! + (make-view-plugin make-user-info-browser user-info?)) \ No newline at end of file