[Linedit-cvs] CVS update: src/complete.lisp src/linedit.asd src/packages.lisp src/utility-functions.lisp src/utility-macros.lisp src/version.lisp-expr
Nikodemus Siivola
nsiivola at common-lisp.net
Mon Apr 12 12:38:42 UTC 2004
Update of /project/linedit/cvsroot/src
In directory common-lisp.net:/tmp/cvs-serv26951
Modified Files:
complete.lisp linedit.asd packages.lisp utility-functions.lisp
utility-macros.lisp version.lisp-expr
Log Message:
* Make completion not stuble on logical pathnames.
* Fix META-ESCAPE to deal with character literals. Not 100% sure this is the right fix, though, but seems to do the job.
Date: Mon Apr 12 08:38:41 2004
Author: nsiivola
Index: src/complete.lisp
diff -u src/complete.lisp:1.5 src/complete.lisp:1.6
--- src/complete.lisp:1.5 Fri Mar 5 14:52:22 2004
+++ src/complete.lisp Mon Apr 12 08:38:41 2004
@@ -28,15 +28,62 @@
(defun underlying-directory-p (pathname)
(case (file-kind pathname)
(:directory t)
- (:symbolic-link (file-kind (merge-pathnames (read-link pathname) pathname)))))
+ (:symbolic-link
+ (file-kind (merge-pathnames (read-link pathname) pathname)))))
(defun relative-pathname-p (pathname)
(let ((dir (pathname-directory pathname)))
(or (null dir)
(eq :relative (car dir)))))
-;; This version of directory-complete isn't nice to symlinks, and
-;; should be replaced by something backed by foreign glue.
+(defun logical-pathname-p (pathname)
+ (typep (pathname pathname) 'logical-pathname))
+
+(defun logical-pathname-complete (string)
+ (values (list string) (length string)))
+
+#+nil
+(defun logical-pathname-complete (string)
+ (let* ((host (pathname-host string))
+ (rest (subseq string (1+ (mismatch host string))))
+ (rules (remove-if-not (lambda (rule)
+ (mismatch rest (first rule)))))
+ (physicals (mapcar (lambda (rule)
+ (namestring
+ (translate-pathname string
+ (first rule)
+ (second rule))))
+ rules))
+ (matches (apply #'append (mapcar #'directory-complete physicals)))
+ (logicals (mapcar (lambda (physical)
+ (let ((rule (find-if (lambda (rule)
+ (misma
+
+ (flet ((maybe-translate-logical-pathname (string)
+ (handler-case
+ (translate-logical-pathname string)
+ (error ()
+ (return-from logical-pathname-complete (values nil 0))))))
+ (directory-complete
+ (namestring
+ (maybe-translate-logical-pathname string)))))
+ ;; FIXME: refactor chared code with directory complete
+ (loop with all
+ with common
+ with max
+ for cand in matches
+ do (let ((diff (mismatch string cand)))
+ (unless (< diff (length string))
+ (setf common (if common
+ (subseq common 0 (mismatch common cand))
+ cand)
+ max (max max (length cand))
+ all (cons cand all))))
+ finally (if (or (null common)
+ (<= (length common) (length string)))
+ (return (values all max))
+ (return (values (list common) (length common))))))))))))))))
+
(defun directory-complete (string)
(declare (simple-string string))
(let* ((common nil)
@@ -56,7 +103,8 @@
(diff (mismatch string full)))
(dbg "~& completed: ~A, diff: ~A~%" full diff)
(unless (< diff (length string))
- (dbg "~& common ~A mismatch ~A~&" common (mismatch common full))
+ (dbg "~& common ~A mismatch ~A~&" common
+ (mismatch common full))
(setf common (if common
(subseq common 0 (mismatch common full))
full)
@@ -72,7 +120,9 @@
(declare (simple-string string))
(when (plusp (length string))
(if (in-quoted-string-p editor)
- (directory-complete string)
+ (if (logical-pathname-p string)
+ (logical-pathname-complete string)
+ (directory-complete string))
(let* ((length (length string))
(first-colon (position #\: string))
(last-colon (position #\: string :from-end t))
Index: src/linedit.asd
diff -u src/linedit.asd:1.28 src/linedit.asd:1.29
--- src/linedit.asd:1.28 Mon Mar 8 01:45:27 2004
+++ src/linedit.asd Mon Apr 12 08:38:41 2004
@@ -54,7 +54,7 @@
(error 'operation-error :component c :operation o)))
(defsystem :linedit
- :version "0.15.9"
+ :version "0.15.10"
:depends-on (:uffi :terminfo :osicat)
:components
(;; Common
Index: src/packages.lisp
diff -u src/packages.lisp:1.16 src/packages.lisp:1.17
--- src/packages.lisp:1.16 Fri Mar 5 13:21:36 2004
+++ src/packages.lisp Mon Apr 12 08:38:41 2004
@@ -28,4 +28,6 @@
#:*default-lines*
#+sbcl #:install-repl
#+sbcl #:uninstall-repl
+ #:start-debug
+ #:end-debug
))
Index: src/utility-functions.lisp
diff -u src/utility-functions.lisp:1.10 src/utility-functions.lisp:1.11
--- src/utility-functions.lisp:1.10 Fri Mar 5 17:10:59 2004
+++ src/utility-functions.lisp Mon Apr 12 08:38:41 2004
@@ -46,9 +46,12 @@
(word-delimiter-p (char string index))))
(defun start-debug (pathname &rest open-args)
+ "Start linedit debugging output to pathname, with additional
+open-args passed to `open'."
(setf *debug* (apply #'open pathname :direction :output open-args)))
(defun end-debug ()
+ "End linedit debugging output."
(close *debug*)
(setf *debug* nil))
@@ -64,9 +67,13 @@
(defun meta-escape (string)
(declare (simple-string string))
(let (stack)
- (loop for i from 1 upto (length string)
+ (loop with last
+ for i from 1 upto (length string)
for char across string
- when (eql #\\ char)
+ ;; KLUDGE: Deal with character literals. Not quite sure this is
+ ;; the right and robust way to do it, though.
+ when (and (eql #\\ char) (not (eql #\# last)))
do (push #\\ stack)
- do (push char stack))
+ do (push char stack)
+ (setf last char))
(coerce (nreverse stack) 'simple-string)))
Index: src/utility-macros.lisp
diff -u src/utility-macros.lisp:1.6 src/utility-macros.lisp:1.7
--- src/utility-macros.lisp:1.6 Thu Mar 4 11:47:09 2004
+++ src/utility-macros.lisp Mon Apr 12 08:38:41 2004
@@ -56,12 +56,13 @@
(with-unique-names (value)
`(let ((,value ,condition))
(unless ,value
- (error "BUG: You seem to have found a bug in Linedit. Please report~
- this incident along with directions to reproduce and the ~
- following message to linedit-devel at common-lisp.net:~
- ~
- `Invariant ~S violated.'"
- ',condition)))))
+ (let ((*print-pretty* nil))
+ (error "BUG: You seem to have found a bug in Linedit. Please report~
+ this incident along with directions to reproduce and the ~
+ following message to linedit-devel at common-lisp.net:~
+ ~
+ `Invariant ~S violated.'"
+ ',condition))))))
(defmacro ensure (symbol expr)
`(or ,symbol (setf ,symbol ,expr)))
Index: src/version.lisp-expr
diff -u src/version.lisp-expr:1.12 src/version.lisp-expr:1.13
--- src/version.lisp-expr:1.12 Fri Mar 5 13:58:58 2004
+++ src/version.lisp-expr Mon Apr 12 08:38:41 2004
@@ -1 +1 @@
-0.15.9
+0.15.10
More information about the linedit-cvs
mailing list