divide plugins into `view-plugins' and `command-plugins'
This commit is contained in:
		
							parent
							
								
									428c9587cc
								
							
						
					
					
						commit
						73e44b5fbd
					
				| 
						 | 
				
			
			@ -335,6 +335,6 @@
 | 
			
		|||
  (and (proper-list? thing)
 | 
			
		||||
       (every fs-object? thing)))
 | 
			
		||||
 | 
			
		||||
(register-plugin! (make-plugin "ls"
 | 
			
		||||
			       browse-dir-list-receiver
 | 
			
		||||
(register-plugin! 
 | 
			
		||||
 (make-view-plugin browse-dir-list-receiver
 | 
			
		||||
		   list-of-fs-objects?))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -336,4 +336,4 @@
 | 
			
		|||
 | 
			
		||||
)))
 | 
			
		||||
 | 
			
		||||
(register-plugin! (make-plugin "browse-list" browse-list-receiver))
 | 
			
		||||
;(register-plugin! (make-plugin "browse-list" browse-list-receiver))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -61,8 +61,8 @@
 | 
			
		|||
	(browse-dir-list-receiver browse-sel-message)))
 | 
			
		||||
      )))
 | 
			
		||||
 | 
			
		||||
(register-plugin!
 | 
			
		||||
 (make-plugin "directory-files"  dir-files-receiver))
 | 
			
		||||
;(register-plugin!
 | 
			
		||||
; (make-plugin "directory-files"  dir-files-receiver))
 | 
			
		||||
	   
 | 
			
		||||
(register-plugin!
 | 
			
		||||
 (make-plugin "ls" dir-files-receiver))
 | 
			
		||||
; (register-plugin!
 | 
			
		||||
;  (make-plugin "ls" dir-files-receiver))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -444,10 +444,10 @@
 | 
			
		|||
	    plugin)))
 | 
			
		||||
     (else 
 | 
			
		||||
      (values 
 | 
			
		||||
       (post-message standard-plugin
 | 
			
		||||
       (post-message standard-view-plugin
 | 
			
		||||
		     (make-next-command-message
 | 
			
		||||
		      command '() (buffer-num-cols command-buffer)))
 | 
			
		||||
       standard-plugin)))))
 | 
			
		||||
       standard-view-plugin)))))
 | 
			
		||||
 | 
			
		||||
;;Extracts the name of the function and its parameters
 | 
			
		||||
(define extract-com-and-par
 | 
			
		||||
| 
						 | 
				
			
			@ -530,18 +530,17 @@
 | 
			
		|||
       (eval (read-sexp-from-string exp) env)))))
 | 
			
		||||
 | 
			
		||||
(define (post-message plugin message)
 | 
			
		||||
  ((plugin-fun plugin) message))
 | 
			
		||||
 | 
			
		||||
(define (determine-plugin-by-command command)
 | 
			
		||||
  (or (find (lambda (r)
 | 
			
		||||
	      (string=? (plugin-command r) command))
 | 
			
		||||
	    (plugin-list))
 | 
			
		||||
      standard-plugin))
 | 
			
		||||
  (cond
 | 
			
		||||
   ((view-plugin? plugin)
 | 
			
		||||
    ((view-plugin-fun plugin) message))
 | 
			
		||||
   (else 
 | 
			
		||||
    (error "don't know how to talk to this plugin type"
 | 
			
		||||
	   plugin))))
 | 
			
		||||
 | 
			
		||||
(define (determine-plugin-by-type result)
 | 
			
		||||
  (find (lambda (r)
 | 
			
		||||
	  ((plugin-type-predicate r) result))
 | 
			
		||||
	(plugin-list)))
 | 
			
		||||
	  ((view-plugin-type-predicate r) result))
 | 
			
		||||
	(view-plugin-list)))
 | 
			
		||||
  
 | 
			
		||||
;;Management of the upper buffer
 | 
			
		||||
;;add a char to the buffer
 | 
			
		||||
| 
						 | 
				
			
			@ -603,12 +602,6 @@
 | 
			
		|||
		       (history-entry-command (entry-data entry)) width)))))
 | 
			
		||||
    (wrefresh win)))
 | 
			
		||||
 | 
			
		||||
(define (post-print-message command result-object)
 | 
			
		||||
  (post-message
 | 
			
		||||
   (determine-plugin-by-command command)
 | 
			
		||||
   (make-print-message command result-object
 | 
			
		||||
		       (buffer-num-cols command-buffer))))
 | 
			
		||||
 | 
			
		||||
(define (paint-result-buffer print-object)
 | 
			
		||||
  (let* ((window (app-window-curses-win result-window))
 | 
			
		||||
	 (text (print-object-text print-object))
 | 
			
		||||
| 
						 | 
				
			
			@ -788,6 +781,7 @@
 | 
			
		|||
   ((selection-message? message)
 | 
			
		||||
    "")))
 | 
			
		||||
 | 
			
		||||
(define standard-plugin
 | 
			
		||||
  (make-plugin #f standard-receiver-rec))
 | 
			
		||||
(define standard-view-plugin
 | 
			
		||||
  (make-view-plugin standard-receiver-rec 
 | 
			
		||||
		    (lambda (val) #t)))
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -101,11 +101,17 @@
 | 
			
		|||
;;; nuit plug-in registration
 | 
			
		||||
 | 
			
		||||
(define-interface plugin-interface
 | 
			
		||||
  (export make-plugin
 | 
			
		||||
	  plugin?
 | 
			
		||||
	  plugin-command
 | 
			
		||||
	  plugin-fun
 | 
			
		||||
	  plugin-type-predicate
 | 
			
		||||
  (export make-view-plugin
 | 
			
		||||
	  view-plugin?
 | 
			
		||||
	  view-plugin-fun
 | 
			
		||||
	  view-plugin-type-predicate
 | 
			
		||||
 | 
			
		||||
	  make-command-plugin
 | 
			
		||||
	  command-plugin?
 | 
			
		||||
	  command-plugin-command
 | 
			
		||||
	  command-plugin-completer
 | 
			
		||||
	  command-plugin-evaluater
 | 
			
		||||
 | 
			
		||||
	  register-plugin!
 | 
			
		||||
 | 
			
		||||
	  make-print-object
 | 
			
		||||
| 
						 | 
				
			
			@ -147,7 +153,8 @@
 | 
			
		|||
	  message-command-string))
 | 
			
		||||
 | 
			
		||||
(define-interface plugin-host-interface
 | 
			
		||||
  (export plugin-list
 | 
			
		||||
  (export command-plugin-list
 | 
			
		||||
	  view-plugin-list
 | 
			
		||||
	  make-next-command-message
 | 
			
		||||
	  make-init-with-result-message
 | 
			
		||||
	  make-key-pressed-message
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,26 +1,33 @@
 | 
			
		|||
(define *plugins* '())
 | 
			
		||||
(define *command-plugins* '())
 | 
			
		||||
 | 
			
		||||
(define (plugin-list)
 | 
			
		||||
  *plugins*)
 | 
			
		||||
(define *view-plugins* '())
 | 
			
		||||
 | 
			
		||||
(define-record-type plugin :plugin
 | 
			
		||||
  (really-make-plugin command fun type-predicate)
 | 
			
		||||
  plugin?
 | 
			
		||||
  (command plugin-command)
 | 
			
		||||
  (fun plugin-fun)
 | 
			
		||||
  (type-predicate plugin-type-predicate))
 | 
			
		||||
(define (command-plugin-list)
 | 
			
		||||
  *command-plugins*)
 | 
			
		||||
 | 
			
		||||
(define-record-discloser :plugin
 | 
			
		||||
  (lambda (r)
 | 
			
		||||
    `(plugin ,(plugin-command r) ,(plugin-fun r))))
 | 
			
		||||
(define (view-plugin-list)
 | 
			
		||||
  *view-plugins*)
 | 
			
		||||
 | 
			
		||||
(define (make-plugin command fun . more)
 | 
			
		||||
  (let-optionals more
 | 
			
		||||
      ((type-predicate (lambda (v) #f)))
 | 
			
		||||
    (really-make-plugin command fun type-predicate)))
 | 
			
		||||
(define-record-type view-plugin :view-plugin
 | 
			
		||||
  (make-view-plugin fun type-predicate)
 | 
			
		||||
  view-plugin?
 | 
			
		||||
  (fun view-plugin-fun)
 | 
			
		||||
  (type-predicate view-plugin-type-predicate))
 | 
			
		||||
 | 
			
		||||
(define-record-type command-plugin :command-plugin
 | 
			
		||||
  (make-command-plugin command completer evaluater)
 | 
			
		||||
  command-plugin?
 | 
			
		||||
  (command command-plugin-command)
 | 
			
		||||
  (completer command-plugin-completer)
 | 
			
		||||
  (evaluater command-plugin-evaluater))
 | 
			
		||||
 | 
			
		||||
(define (register-plugin! plugin)
 | 
			
		||||
  (set! *plugins* (cons plugin *plugins*)))
 | 
			
		||||
  (cond
 | 
			
		||||
   ((command-plugin? plugin)
 | 
			
		||||
    (set! *command-plugins* (cons plugin *command-plugins*)))
 | 
			
		||||
   ((view-plugin? plugin)
 | 
			
		||||
    (set! *view-plugins* (cons plugin *view-plugins*)))
 | 
			
		||||
   (error "unknown plugin type" plugin)))
 | 
			
		||||
 | 
			
		||||
;; answers
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -36,4 +36,4 @@
 | 
			
		|||
    "'()")))
 | 
			
		||||
 | 
			
		||||
(register-plugin! 
 | 
			
		||||
 (make-plugin "ps" pps-receiver list-of-processes?))
 | 
			
		||||
 (make-view-plugin pps-receiver list-of-processes?))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue