Browser for user-info
This commit is contained in:
		
							parent
							
								
									243e746136
								
							
						
					
					
						commit
						0cb71508ef
					
				|  | @ -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 | ||||
|  |  | |||
|  | @ -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