Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv963
Modified Files: gui.lisp packages.lisp pane.lisp slidemacs-gui.lisp Log Message: The COMPLETABLE-PATHNAME class
This patch mainly removes the class COMPLETABLE-PATHNAME. There is nothing special about those pathnames that make them completable. They are just ordinary pathnames (no offence meant). Instead, the ACCEPT and PRESENT method that formerly specialized on that presentation type, specialize now on the ordinary PATHNAME class *and* on climacs' custom view class CLIMACS-TEXTUAL-VIEW, that was already defined in pane.lisp but was not yet used anywhere. (Robert Strandh accedes: "I think it must have been meant for this kind of situation.")
The variable climacs-pane:+climacs-textual-view+ has been added, it hold an instance of the class climacs-pane:climacs-textual-view, just as there are such variables for the standard view classes (see clim spec 23.6). Both symbols, #:climacs-textual-view and #:+climacs-textual-view+, of the package CLIMACS-PANE are exported.
+climacs-textual-view+ is the :DEFAULT-VIEW for the class CLIMACS-GUI::CLIMACS-MINIBUFFER-PANE now (set via the :DEFAULT-INITARGS parameter of the class definition) so that the aforementioned ACCEPT and PRESENT methods for pathnames are used in the minibuffer. (See at the beginning of gui.lisp.)
The :DEFAULT-VIEW for the class CLIMACS-PANE:CLIMACS-PANE was not specified in the same way, but in the :AFTER method of (initialize-instance (pane climacs-pane)) via the line:
(setf (stream-default-view pane) (make-instance 'climacs-textual-view))
This is changed to be specified in the appropriate DEFCLASS form, as well.
As the :DEFAULT-VIEW of the minibuffer is now changed, all the calls to (accept 'completable-pathname :prompt "..") are now substituted by just (accept 'pathname :prompt "..") without the need for explicit specification by use of the :VIEW keyword. All these calls are changed, even the one in slidemacs-gui.lisp.
(If we feel the need for a special view class for the info-pane we can always subclass CLIMACS-MINIBUFFER-PANE later. Only the :DEFAULT-VIEW inside the :DEFAULT-INITARGS argument has to be changed then, if we do things correctly.)
The function CLIMACS-GUI:CLIMACS
I added the keywords NEW-PROCESS and PROCESS-NAME to the lambda-list and the correspondent construct. You can now do (climacs-gui:climacs :new-process t) Just as it is possible with Clouseau and the Climacs-Listener.
CLIMACS-GUI:CLIMACS is also exported now. Why wasn't it before?
Some further comments, in case this message is not long enough for you, can be found in the original mail in which I published my patch: http://article.gmane.org/gmane.lisp.climacs.devel/264
Date: Thu Sep 1 02:21:09 2005 Author: mretzlaff
Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.184 climacs/gui.lisp:1.185 --- climacs/gui.lisp:1.184 Tue Aug 30 19:28:52 2005 +++ climacs/gui.lisp Thu Sep 1 02:21:08 2005 @@ -47,7 +47,8 @@ (defclass climacs-minibuffer-pane (minibuffer-pane) () (:default-initargs - :height 20 :max-height 20 :min-height 20)) + :height 20 :max-height 20 :min-height 20 + :default-view +climacs-textual-view+))
(defparameter *with-scrollbars* t "If T, classic look and feel. If NIL, stripped-down look (:") @@ -98,11 +99,15 @@ (loop for buffer in buffers do (clear-modify buffer))))
-(defun climacs (&key (width 900) (height 400)) +(defun climacs (&key new-process (process-name "Climacs") + (width 900) (height 400)) "Starts up a climacs session" - (let ((frame (make-application-frame - 'climacs :width width :height height))) - (run-frame-top-level frame))) + (let ((frame (make-application-frame 'climacs :width width :height height))) + (flet ((run () + (run-frame-top-level frame))) + (if new-process + (clim-sys:make-process #'run :name process-name) + (run)))))
(defun display-info (frame pane) (declare (ignore frame)) @@ -696,10 +701,6 @@ (set-key 'com-fill-paragraph 'global-climacs-table '((#\q :meta)))
-(eval-when (:compile-toplevel :load-toplevel) - (define-presentation-type completable-pathname () - :inherit-from 'pathname)) - (defun filename-completer (so-far mode) (flet ((remove-trail (s) (subseq s 0 (let ((pos (position #/ s :from-end t))) @@ -768,15 +769,12 @@ collect (list (subseq (namestring name) length nil) name))))))))
-(define-presentation-method present (object (type completable-pathname) - stream (view textual-view) - &key acceptably for-context-type) - (declare (ignore acceptably for-context-type)) +(define-presentation-method present (object (type pathname) + stream (view climacs-textual-view) &key) (princ (namestring object) stream))
-(define-presentation-method accept - ((type completable-pathname) stream (view textual-view) &key (default nil defaultp) - (default-type type)) +(define-presentation-method accept ((type pathname) stream (view climacs-textual-view) + &key (default nil defaultp) (default-type type)) (multiple-value-bind (pathname success string) (complete-input stream #'filename-completer @@ -851,8 +849,7 @@ buffer))))))
(define-named-command com-find-file () - (let* ((filepath (accept 'completable-pathname - :prompt "Find File"))) + (let* ((filepath (accept 'pathname :prompt "Find File"))) (find-file filepath)))
(set-key 'com-find-file 'global-climacs-table @@ -895,7 +892,7 @@ nil)))))))
(define-named-command com-find-file-read-only () - (let ((filepath (accept 'completable-pathname :Prompt "Find file read only"))) + (let ((filepath (accept 'pathname :Prompt "Find file read only"))) (find-file-read-only filepath)))
(set-key 'com-find-file-read-only 'global-climacs-table @@ -914,12 +911,11 @@ (needs-saving buffer) t))
(define-named-command com-set-visited-file-name () - (let ((filename (accept 'completable-pathname :prompt "New file name"))) + (let ((filename (accept 'pathname :prompt "New file name"))) (set-visited-file-name filename (buffer (current-window)))))
(define-named-command com-insert-file () - (let ((filename (accept 'completable-pathname - :prompt "Insert File")) + (let ((filename (accept 'pathname :prompt "Insert File")) (pane (current-window))) (when (probe-file filename) (setf (mark pane) (clone-mark (point pane) :left)) @@ -970,8 +966,7 @@
(defun save-buffer (buffer) (let ((filepath (or (filepath buffer) - (accept 'completable-pathname - :prompt "Save Buffer to File")))) + (accept 'pathname :prompt "Save Buffer to File")))) (cond ((directory-pathname-p filepath) (display-message "~A is a directory." filepath) @@ -1018,8 +1013,7 @@ (call-next-method)))
(define-named-command com-write-buffer () - (let ((filepath (accept 'completable-pathname - :prompt "Write Buffer to File")) + (let ((filepath (accept 'pathname :prompt "Write Buffer to File")) (buffer (buffer (current-window)))) (cond ((directory-pathname-p filepath) @@ -1146,8 +1140,7 @@ (beep))))))
(define-named-command com-load-file () - (let ((filepath (accept 'completable-pathname - :prompt "Load File"))) + (let ((filepath (accept 'pathname :prompt "Load File"))) (load-file filepath)))
(set-key 'com-load-file 'global-climacs-table
Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.79 climacs/packages.lisp:1.80 --- climacs/packages.lisp:1.79 Fri Aug 19 11:12:48 2005 +++ climacs/packages.lisp Thu Sep 1 02:21:08 2005 @@ -157,7 +157,8 @@ #:query-replace-mode #:mark-visible-p #:with-undo - #:url)) + #:url + #:climacs-textual-view #:+climacs-textual-view+))
(defpackage :climacs-fundamental-syntax (:use :clim-lisp :clim :climacs-buffer :climacs-base @@ -197,5 +198,5 @@ (defpackage :climacs-gui (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev :climacs-syntax :climacs-kill-ring :climacs-pane :clim-extensions :undo :esa) - (:import-from :climacs-lisp-syntax :lisp-string)) - + (:import-from :climacs-lisp-syntax :lisp-string) + (:export :climacs))
Index: climacs/pane.lisp diff -u climacs/pane.lisp:1.31 climacs/pane.lisp:1.32 --- climacs/pane.lisp:1.31 Sun Aug 28 15:57:33 2005 +++ climacs/pane.lisp Thu Sep 1 02:21:08 2005 @@ -222,6 +222,8 @@ (defclass climacs-textual-view (textual-view tabify-mixin) ())
+(defparameter +climacs-textual-view+ (make-instance 'climacs-textual-view)) + (defclass filepath-mixin () ((filepath :initform nil :accessor filepath)))
@@ -276,7 +278,10 @@ (full-redisplay-p :initform nil :accessor full-redisplay-p) (cache :initform (let ((cache (make-instance 'standard-flexichain))) (insert* cache 0 nil) - cache)))) + cache))) + (:default-initargs + :default-view +climacs-textual-view+)) +
(defmethod tab-width ((pane climacs-pane)) (tab-width (stream-default-view pane))) @@ -295,7 +300,6 @@ (with-slots (buffer top bot scan) pane (setf top (clone-mark (low-mark buffer) :left) bot (clone-mark (high-mark buffer) :right))) - (setf (stream-default-view pane) (make-instance 'climacs-textual-view)) (with-slots (space-width tab-width) (stream-default-view pane) (let* ((medium (sheet-medium pane)) (style (medium-text-style medium)))
Index: climacs/slidemacs-gui.lisp diff -u climacs/slidemacs-gui.lisp:1.17 climacs/slidemacs-gui.lisp:1.18 --- climacs/slidemacs-gui.lisp:1.17 Tue Aug 30 19:28:52 2005 +++ climacs/slidemacs-gui.lisp Thu Sep 1 02:21:08 2005 @@ -570,5 +570,5 @@ (if (not (and (typep pane 'climacs-pane) (typep (syntax (buffer pane)) 'slidemacs-gui-syntax))) (beep) - (let ((file (accept 'climacs-gui::completable-pathname :prompt "Output to"))) - (postscript-print-pane pane file))))) \ No newline at end of file + (let ((file (accept 'pathname :prompt "Output to"))) + (postscript-print-pane pane file)))))