Browser for user-info
This commit is contained in:
		
							parent
							
								
									243e746136
								
							
						
					
					
						commit
						0cb71508ef
					
				|  | @ -86,6 +86,20 @@ | ||||||
| 	tty-debug) | 	tty-debug) | ||||||
|   (files process)) |   (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 | ;;; file list view plugin | ||||||
| 
 | 
 | ||||||
| (define-structure dirlist-view-plugin (export) | (define-structure dirlist-view-plugin (export) | ||||||
|  | @ -124,6 +138,7 @@ | ||||||
|     (export make-standard-viewer) |     (export make-standard-viewer) | ||||||
|   (open scheme |   (open scheme | ||||||
| 
 | 
 | ||||||
|  |         tty-debug | ||||||
| 	objects | 	objects | ||||||
| 	layout) | 	layout) | ||||||
|   (files std-viewer)) |   (files std-viewer)) | ||||||
|  | @ -326,6 +341,7 @@ | ||||||
| 	select-list | 	select-list | ||||||
| 	;; the following modules are plugins | 	;; the following modules are plugins | ||||||
| 	dirlist-view-plugin | 	dirlist-view-plugin | ||||||
|  |         user-group-info-plugin | ||||||
| 	process-viewer | 	process-viewer | ||||||
| 	standard-command-plugin | 	standard-command-plugin | ||||||
| 	standard-viewer | 	standard-viewer | ||||||
|  |  | ||||||
|  | @ -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?)) | ||||||
		Loading…
	
		Reference in New Issue
	
	 mainzelm
						mainzelm