From thenriksen at common-lisp.net Sun Dec 10 19:37:12 2006 From: thenriksen at common-lisp.net (thenriksen) Date: Sun, 10 Dec 2006 14:37:12 -0500 (EST) Subject: [climacs-cvs] CVS climacs Message-ID: <20061210193712.8C6F82104C@common-lisp.net> Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv25030 Modified Files: INSTALL Log Message: It's no longer necessary to check out ESA. --- /project/climacs/cvsroot/climacs/INSTALL 2006/11/24 22:52:27 1.9 +++ /project/climacs/cvsroot/climacs/INSTALL 2006/12/10 19:37:12 1.10 @@ -13,7 +13,6 @@ how you do it: cvs -z3 -d :pserver:anonymous:anonymous at common-lisp.net:/project/flexichain/cvsroot co flexichain - cvs -z3 -d :pserver:anonymous:anonymous at common-lisp.net:/project/climacs/cvsroot co esa Ensure that asdf can find the .asd files for these projects. Recent versions of McCLIM depend on Flexichain, and thus, you might From thenriksen at common-lisp.net Sun Dec 10 19:45:00 2006 From: thenriksen at common-lisp.net (thenriksen) Date: Sun, 10 Dec 2006 14:45:00 -0500 (EST) Subject: [climacs-cvs] CVS climacs Message-ID: <20061210194500.981622D0B9@common-lisp.net> Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv27038 Modified Files: climacs-lisp-syntax-commands.lisp climacs-lisp-syntax.lisp gui.lisp Log Message: Updated to keep up with Drei changes, in particular the improvements to the Lisp syntax module. --- /project/climacs/cvsroot/climacs/climacs-lisp-syntax-commands.lisp 2006/11/14 12:42:06 1.2 +++ /project/climacs/cvsroot/climacs/climacs-lisp-syntax-commands.lisp 2006/12/10 19:44:56 1.3 @@ -117,7 +117,7 @@ "Edit definition of the symbol at point. If there is no symbol at point, this is a no-op." (let* ((token (this-form *current-point* *current-syntax*)) - (this-symbol (token-to-object *current-syntax* token))) + (this-symbol (form-to-object *current-syntax* token))) (when (and this-symbol (symbolp this-symbol)) (edit-definition this-symbol)))) --- /project/climacs/cvsroot/climacs/climacs-lisp-syntax.lisp 2006/11/14 12:42:06 1.2 +++ /project/climacs/cvsroot/climacs/climacs-lisp-syntax.lisp 2006/12/10 19:44:56 1.3 @@ -252,7 +252,7 @@ (defun macroexpand-token (syntax token &optional (all nil)) (with-syntax-package (syntax (start-offset token)) - (let* ((string (token-string syntax token)) + (let* ((string (form-string syntax token)) (expression (read-from-string string)) (expansion (macroexpand-for-drei (get-usable-image syntax) expression @@ -275,7 +275,7 @@ (defun compile-definition-interactively (mark syntax) (let* ((token (definition-at-mark mark syntax)) - (string (token-string syntax token)) + (string (form-string syntax token)) (m (clone-mark mark)) (buffer-name (name (buffer syntax))) (*read-base* (base syntax))) @@ -284,7 +284,7 @@ (backward-definition m syntax) (multiple-value-bind (result notes) (compile-form-for-drei (get-usable-image syntax) - (token-to-object syntax token + (form-to-object syntax token :read t :package (package-at-mark syntax mark)) (buffer syntax) --- /project/climacs/cvsroot/climacs/gui.lisp 2006/11/22 18:27:03 1.233 +++ /project/climacs/cvsroot/climacs/gui.lisp 2006/12/10 19:44:56 1.234 @@ -295,13 +295,17 @@ "") pane)))) +(defmethod handle-drei-condition ((drei climacs-pane) condition) + (call-next-method) + (display-drei drei)) + (defmethod execute-frame-command :around ((frame climacs) command) (handling-drei-conditions (with-undo ((buffers frame)) - (call-next-method)) - (loop for buffer in (buffers frame) - do (when (modified-p buffer) - (clear-modify buffer))))) + (call-next-method))) + (loop for buffer in (buffers frame) + do (when (modified-p buffer) + (clear-modify buffer)))) (defmethod execute-frame-command :after ((frame climacs) command) (when (eq frame *application-frame*) From thenriksen at common-lisp.net Mon Dec 18 17:54:41 2006 From: thenriksen at common-lisp.net (thenriksen) Date: Mon, 18 Dec 2006 12:54:41 -0500 (EST) Subject: [climacs-cvs] CVS climacs Message-ID: <20061218175441.1BB6936002@common-lisp.net> 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.