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))