[climacs-cvs] CVS update: climacs/gui.lisp climacs/packages.lisp climacs/pane.lisp climacs/slidemacs-gui.lisp
Max-Gerd Retzlaff
mretzlaff at common-lisp.net
Thu Sep 1 00:21:10 UTC 2005
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)))))
More information about the Climacs-cvs
mailing list