diff --git a/scheme/user-group-info.scm b/scheme/user-group-info.scm index 1942965..73bace3 100644 --- a/scheme/user-group-info.scm +++ b/scheme/user-group-info.scm @@ -1,5 +1,145 @@ (define key-return 10) +(define-record-type id-output :id-output + (make-id-output uid name gid group groups) + id-output? + (uid id-output-uid) + (name id-output-name) + (gid id-output-gid) + (group id-output-group) + (groups id-output-groups)) + +(define id-regexp + (rx + (: "uid=" (submatch (+ digit)) + "(" (submatch (+ alphabetic)) + ") gid=" (submatch (+ digit)) + "(" (submatch (+ alphabetic)) + ") groups=" (submatch (* any))))) + +(define (parse-group-list s) + (let ((gid-or-gid/name + (rx (| (submatch (+ digit)) + (: (submatch (+ digit)) + "(" + (submatch (+ alphabetic)) + ")"))))) + (regexp-fold + gid-or-gid/name + (lambda (start match l) + (cond ((match:substring match 1) + => (lambda (gid) + (cons gid l))) + (else + (cons (cons (match:substring match 2) + (match:substring match 3)) + l)))) + '() s))) + +(define (id command args) + ;; TODO parse command line arguments + (let* ((maybe-username (if (null? args) + '() + args)) + (out (run/string (id ,@ maybe-username))) + (match (regexp-search id-regexp out))) + (if match + (make-id-output + (match:substring match 1) + (match:substring match 2) + (match:substring match 3) + (match:substring match 4) + (parse-group-list (match:substring match 5))) + 'cannot-parse))) + +(register-plugin! + (make-command-plugin + "id" + #f + id)) + +(define (make-id-output-select-list ido num-lines) + (make-select-list + `(,(make-unmarked-element + (cons 'user + (string->number + (id-output-uid ido))) + #t + (string-append "UID: " (id-output-uid ido))) + ,(make-unmarked-element + (cons 'user (id-output-name ido)) + #t + (string-append "Name: " (id-output-name ido))) + ,(make-unmarked-element + (cons 'group + (string->number + (id-output-gid ido))) + #t + (string-append "GID: " (id-output-gid ido))) + ,(make-unmarked-element + (cons 'group + (id-output-group ido)) + #t + (string-append "GID: " (id-output-group ido))) + ,(make-unmarked-element + 'text + #f + "Groups:") + ,@(map (lambda (group) + (let ((gid (if (pair? group) + (car group) + group)) + (gname (if (pair? group) + (cdr group) + ""))) + (make-unmarked-element + (cons 'group (string->number gid)) + #t + (string-append " " gid " " gname)))) + (id-output-groups ido))) + num-lines)) + +(define (make-id-output-browser ido buffer) + (let ((ido ido) + (buffer buffer) + (selection-list + (make-id-output-select-list + ido + (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?) + (cond + ((= key key-return) + (let ((selected + (select-list-selected-entry selection-list))) + (cond + ((and (pair? selected) + (eq? (car selected) 'user)) + (make-user-info-browser + (user-info (cdr selected)) buffer)) + ((and (pair? selected) + (eq? (car selected) 'group)) + (make-group-info-browser + (group-info (cdr selected)) buffer)) + (else self)))) + (else + (set! selection-list + (select-list-handle-key-press + selection-list key)) + self)))) + (else + (error "unknown message in make-id-output-browser" + message)))))) + +(register-plugin! + (make-view-plugin make-id-output-browser id-output?)) + (define (make-gi-select-list gi num-lines) (make-select-list `(,(make-unmarked-element 'name