[Morphologie-cvs] r13 - trunk/src

[ksprotte at common-lisp.net]

Author: ksprotte
Date: Thu Jul  5 12:27:57 2007
New Revision: 13

Added:
   trunk/src/package.lisp
   trunk/src/utils.lisp
Log:
added two files


Added: trunk/src/package.lisp
==============================================================================
--- (empty file)
+++ trunk/src/package.lisp	Thu Jul  5 12:27:57 2007
@@ -0,0 +1,4 @@
+(defpackage :morphologie
+  (:use :cl :ompw)
+  (:nicknames :morph))
+

Added: trunk/src/utils.lisp
==============================================================================
--- (empty file)
+++ trunk/src/utils.lisp	Thu Jul  5 12:27:57 2007
@@ -0,0 +1,72 @@
+(in-package :morph)
+
+(defun list! (thing)
+  (if (listp thing) thing (list thing)))
+
+(defun mat-trans (matrix)
+  (assert (apply #'= (mapcar #'length matrix)) nil
+	  "this should not happen. Please report this to Kilian Sprotte")
+  (when matrix (apply #'mapcar #'list matrix)))
+
+(defun group-list (list segmentation mode)  
+  "Segments a <list> in successives sublists 
+which lengths are successive values of the list <segmentation>.
+ <mode> indicates if <list> is to be read in a circular way."
+  (let ((list2 list) (res nil))
+    (catch 'gl
+      (loop for segment in segmentation
+	 while (or list2 (eq mode 'circular))
+	 do (push (loop for i from 1 to segment
+		     when (null list2)
+		     do (ecase mode
+			  (linear (push sublist res) (throw 'gl 0))
+			  (circular (setf list2 list)))
+		     end
+		     collect (pop list2) into sublist
+		     finally (return sublist))
+		  res)))
+    (nreverse res)))
+
+(defun flat-once (list)
+  (if (consp (car list))
+      (apply 'append list)  list))
+
+#-(or lispworks digitool)
+(defun choose-new-file-dialog (&key (prompt "Enter the path for a new file:")
+			       button-string)
+  (declare (ignore button-string))
+  (format *query-io* "~&~a~%[please enter a path like /tmp/test.txt]~%" prompt)
+  (force-output *query-io*)
+  (parse-namestring (read-line *query-io*)))
+
+#+digitool
+(defun choose-new-file-dialog (&key (prompt "Enter the path for a new file:")
+			       button-string)
+  (ccl::choose-new-file-dialog :prompt prompt :button-string button-string))
+
+#+lispworks
+(defun choose-new-file-dialog (&key (prompt "Enter the path for a new file:")
+                                    button-string)
+  (capi:prompt-for-file prompt :operation :save))
+
+#-(or lispworks digitool)
+(defun choose-file-dialog (&key (prompt "Enter the path for an existing file:")
+                                button-string)  
+  (format *query-io* "~&~a~%[please enter a path like /tmp/test.txt]~%" prompt)
+  (force-output *query-io*)
+  (let ((path (parse-namestring (read-line *query-io*))))
+    (if (probe-file path)
+	path
+      (progn
+        (format *query-io* "~&ERROR: ~A does not exist.~%" path)
+        (choose-file-dialog :prompt prompt :button-string button-string)))))
+
+#+digitool
+(defun choose-file-dialog (&key (prompt "Enter the path for an existing file:")
+                                button-string)  
+  (ccl::choose-file-dialog :prompt prompt :button-string button-string))
+
+#+lispworks
+(defun choose-file-dialog (&key (prompt "Enter the path for a new file:")
+                                button-string)
+  (capi:prompt-for-file prompt))