[climacs-cvs] CVS climacs

[thenriksen]

Update of /project/climacs/cvsroot/climacs
In directory clnet:/tmp/cvs-serv2446

Modified Files:
	file-commands.lisp 
Log Message:
These definitions are not necessary anymore (and haven't been for
quite a while).


--- /project/climacs/cvsroot/climacs/file-commands.lisp	2006/11/12 16:06:06	1.26
+++ /project/climacs/cvsroot/climacs/file-commands.lisp	2006/12/18 17:54:40	1.27
@@ -30,91 +30,6 @@
 
 (in-package :climacs-commands)
 
-(defun filename-completer (so-far mode)
-  (flet ((remove-trail (s)
-	   (subseq s 0 (let ((pos (position #\/ s :from-end t)))
-			 (if pos (1+ pos) 0)))))
-    (let* ((directory-prefix
-	    (if (and (plusp (length so-far)) (eql (aref so-far 0) #\/))
-		""
-		(namestring #+sbcl *default-pathname-defaults*
-                            #+cmu (ext:default-directory)
-                            #-(or sbcl cmu) *default-pathname-defaults*)))
-	   (full-so-far (concatenate 'string directory-prefix so-far))
-	   (pathnames
-	    (loop with length = (length full-so-far)
-		  and wildcard = (concatenate 'string (remove-trail so-far) "*.*")
-		  for path in
-		  #+(or sbcl cmu lispworks) (directory wildcard)
-		  #+openmcl (directory wildcard :directories t)
-		  #+allegro (directory wildcard :directories-are-files nil)
-		  #+cormanlisp (nconc (directory wildcard)
-				      (cl::directory-subdirs dirname))
-		  #-(or sbcl cmu lispworks openmcl allegro cormanlisp)
-		    (directory wildcard)
-		  when (let ((mismatch (mismatch (namestring path) full-so-far)))
-			 (or (null mismatch) (= mismatch length)))
-		    collect path))
-	   (strings (mapcar #'namestring pathnames))
-	   (first-string (car strings))
-	   (length-common-prefix nil)
-	   (completed-string nil)
-	   (full-completed-string nil))
-      (unless (null pathnames)
-	(setf length-common-prefix
-	      (loop with length = (length first-string)
-		    for string in (cdr strings)
-		    do (setf length (min length (or (mismatch string first-string) length)))
-		    finally (return length))))
-      (unless (null pathnames)
-	(setf completed-string
-	      (subseq first-string (length directory-prefix)
-		      (if (null (cdr pathnames)) nil length-common-prefix)))
-	(setf full-completed-string
-	      (concatenate 'string directory-prefix completed-string)))
-      (case mode
-	((:complete-limited :complete-maximal)
-	 (cond ((null pathnames)
-		(values so-far nil nil 0 nil))
-	       ((null (cdr pathnames))
-		(values completed-string t (car pathnames) 1 nil))
-	       (t
-		(values completed-string nil nil (length pathnames) nil))))
-	(:complete
-	 (cond ((null pathnames)
-		(values so-far t so-far 1 nil))
-	       ((null (cdr pathnames))
-		(values completed-string t (car pathnames) 1 nil))
-	       ((find full-completed-string strings :test #'string-equal)
-		(let ((pos (position full-completed-string strings :test #'string-equal)))
-		  (values completed-string
-			  t (elt pathnames pos) (length pathnames) nil)))
-	       (t
-		(values completed-string nil nil (length pathnames) nil))))
-	(:possibilities
-	 (values nil nil nil (length pathnames)
-		 (loop with length = (length directory-prefix)
-		       for name in pathnames
-		       collect (list (subseq (namestring name) length nil)
-				     name))))))))
-
-(define-presentation-method present (object (type pathname)
-                                            stream (view drei-textual-view) &key)
-  (princ (namestring object) stream))
-
-(define-presentation-method accept ((type pathname) stream (view drei-textual-view)
-                                    &key (default nil defaultp) (default-type type))
-  (multiple-value-bind (pathname success string)
-      (complete-input stream
-		      #'filename-completer
-		      :allow-any-input t)
-    (cond (success
-	   (values (or pathname (parse-namestring string)) type))
-	  ((and (zerop (length string))
-		defaultp)
-	   (values default default-type))
-	  (t (values string 'string)))))
-    
 (define-command (com-reparse-attribute-list :name t :command-table buffer-table)
     ()
   "Reparse the current buffer's attribute list.