Better interface for pasting

part of darcs patch Thu Sep 22 00:43:18 EEST 2005  Martin Gasbichler <gasbichl@informatik.uni-tuebingen.de>

scheme/modal-window.scm

@@ -0,0 +1,9 @@
+(define maybe-modal-window #f)
+
+(define (set-modal-window! reader)
+  (if maybe-modal-window
+      (error "tried to set a second modal window"))
+  (set! maybe-modal-window reader))
+
+(define (close-modal-window!)
+  (set! maybe-modal-window #f))

scheme/nuit-packages.scm

@@ -11,11 +11,14 @@
 (define-interface utils-interface
   (export display-to-string
           write-to-string
-          on/off-option-processor))
+          on/off-option-processor
+          paste-selection))
 
 (define-structure utils utils-interface
   (open scheme
-        srfi-6)
+        srfi-6
+        (subset srfi-13 (string-join))
+        formats)
   (files utils))
 
 ;;; history data structure
@@ -242,7 +245,8 @@
 
 (define-structure network-viewer (export)
   (open scheme-with-scsh
-        
+        (subset srfi-13 (string-join))
+
         plugin
         select-line)
   (files network-viewer))
@@ -342,6 +346,7 @@
 	  paint-selection-list-at
 	  select-list-get-selection
           select-list-get-marked
+          select-list-has-marks?
 	  select-list-selected-entry
 
 	  select-list-key?

scheme/select-list.scm

@@ -154,6 +154,14 @@
        (filter element-marked? 
 	       (select-list-elements select-list))))
 
+(define (select-list-has-marks? select-list)
+  (let lp ((elts (select-list-elements select-list)))
+    (if (null? elts)
+        #f
+        (if (element-marked? (car elts))
+            #t
+            (lp (cdr elts))))))
+
 (define (select-list-selected-entry select-list)
   (element-value
    (select-list-selected-element select-list)))

scheme/utils.scm

@@ -13,3 +13,14 @@
   (lambda (option arg-name arg ops)
     (cons (cons name #t) ops)))
 
+
+(define (paste-selection vals marks? for-scheme-mode? to-scheme to-command)
+  (if marks?
+      (if for-scheme-mode?
+          (format #f "'(~a)" (string-join (map to-scheme vals)))
+          (string-join (map to-command vals)))
+      (if (null? vals)
+          ""
+          (if for-scheme-mode?
+              (to-scheme (car vals))
+              (to-command (car vals))))))