[climacs-cvs] CVS update: climacs/gui.lisp climacs/pane.lisp climacs/syntax.lisp
Robert Strandh
rstrandh at common-lisp.net
Mon Jan 17 07:10:22 UTC 2005
Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv18965
Modified Files:
gui.lisp pane.lisp syntax.lisp
Log Message:
implemented full-redisplay (C-l).
implemented multi-buffer support, with C-x b bound to
the command switch-to-buffer. Buffer completion works as
expected.
Date: Mon Jan 17 08:10:19 2005
Author: rstrandh
Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.74 climacs/gui.lisp:1.75
--- climacs/gui.lisp:1.74 Sun Jan 16 21:24:07 2005
+++ climacs/gui.lisp Mon Jan 17 08:10:19 2005
@@ -46,7 +46,8 @@
(window-clear pane))
(define-application-frame climacs ()
- ((win :reader win))
+ ((win :reader win)
+ (buffers :initform '() :accessor buffers))
(:panes
(win (make-pane 'extended-pane
:width 900 :height 400
@@ -183,7 +184,9 @@
command-parser command-unparser
partial-command-parser prompt)
(declare (ignore command-parser command-unparser partial-command-parser prompt))
- (setf (slot-value frame 'win) (find-pane-named frame 'win))
+ (with-slots (win) frame
+ (setf win (find-pane-named frame 'win))
+ (push (buffer win) (buffers frame)))
(let ((*standard-output* (find-pane-named frame 'win))
(*standard-input* (find-pane-named frame 'int))
(*print-pretty* nil)
@@ -505,6 +508,7 @@
:prompt "Find File"))
(buffer (make-instance 'climacs-buffer))
(pane (win *application-frame*)))
+ (push buffer (buffers *application-frame*))
(setf (buffer (win *application-frame*)) buffer)
(setf (syntax buffer) (make-instance 'basic-syntax))
(with-open-file (stream filename :direction :input :if-does-not-exist :create)
@@ -543,6 +547,31 @@
(needs-saving buffer) nil)
(display-message "Wrote: ~a" (filename buffer))))
+(define-presentation-method accept
+ ((type buffer) stream (view textual-view) &key)
+ (multiple-value-bind (object success string)
+ (complete-input stream
+ (lambda (so-far action)
+ (complete-from-possibilities
+ so-far (buffers *application-frame*) '() :action action
+ :name-key #'name
+ :value-key #'identity))
+ :partial-completers '(#\Space)
+ :allow-any-input t)
+ (declare (ignore success string))
+ object))
+
+(define-named-command com-switch-to-buffer ()
+ (let ((buffer (accept 'buffer
+ :prompt "Switch to buffer")))
+ (setf (buffer (win *application-frame*)) buffer)
+ (setf (syntax buffer) (make-instance 'basic-syntax))
+ (beginning-of-buffer (point (win *application-frame*)))
+ (full-redisplay (win *application-frame*))))
+
+(define-named-command com-full-redisplay ()
+ (full-redisplay (win *application-frame*)))
+
(define-named-command com-load-file ()
(let ((filename (accept 'completable-pathname
:prompt "Load File")))
@@ -720,6 +749,7 @@
(global-set-key '(#\e :control) 'com-end-of-line)
(global-set-key '(#\d :control) `(com-delete-object ,*numeric-argument-marker*))
(global-set-key '(#\p :control) 'com-previous-line)
+(global-set-key '(#\l :control) 'com-full-redisplay)
(global-set-key '(#\n :control) 'com-next-line)
(global-set-key '(#\o :control) 'com-open-line)
(global-set-key '(#\k :control) 'com-kill-line)
@@ -779,6 +809,7 @@
(add-command-to-command-table command 'c-x-climacs-table
:keystroke gesture :errorp nil))
+(c-x-set-key '(#\b) 'com-switch-to-buffer)
(c-x-set-key '(#\c :control) 'com-quit)
(c-x-set-key '(#\f :control) 'com-find-file)
(c-x-set-key '(#\l :control) 'com-load-file)
Index: climacs/pane.lisp
diff -u climacs/pane.lisp:1.1 climacs/pane.lisp:1.2
--- climacs/pane.lisp:1.1 Sat Jan 15 20:50:43 2005
+++ climacs/pane.lisp Mon Jan 17 08:10:19 2005
@@ -67,6 +67,7 @@
(cursor-y :initform 2)
(space-width :initform nil)
(tab-width :initform nil)
+ (full-redisplay-p :initform nil :accessor full-redisplay-p)
(cache :initform (let ((cache (make-instance 'standard-flexichain)))
(insert* cache 0 nil)
cache))))
@@ -223,7 +224,7 @@
;;; of the pane by moving top half a pane-size up.
(defun reposition-window (pane)
(let ((nb-lines-in-pane (nb-lines-in-pane pane)))
- (with-slots (top bot cache) pane
+ (with-slots (top cache) pane
(empty-cache cache)
(setf (offset top) (offset (point pane)))
(loop do (beginning-of-line top)
@@ -296,15 +297,11 @@
(beginning-of-line (point pane))
(empty-cache cache)))))
-(defgeneric redisplay-pane (pane))
-
-(defmethod redisplay-pane ((pane climacs-pane))
+(defun display-cache (pane)
(let* ((medium (sheet-medium pane))
(style (medium-text-style medium))
(height (text-style-height style medium)))
(with-slots (top bot scan cache cursor-x cursor-y) pane
- (adjust-cache pane)
- (fill-cache pane)
(loop with start-offset = (offset top)
for id from 0 below (nb-elements cache)
do (setf scan start-offset)
@@ -327,7 +324,20 @@
(draw-rectangle* pane
(1- cursor-x) (- cursor-y (* 0.2 height))
(+ cursor-x 2) (+ cursor-y (* 0.8 height))
- :ink +red+)))))
+ :ink +red+)))))
+
+(defgeneric redisplay-pane (pane))
+
+(defmethod redisplay-pane ((pane climacs-pane))
+ (if (full-redisplay-p pane)
+ (progn (reposition-window pane)
+ (adjust-cache-size-and-bot pane)
+ (setf (full-redisplay-p pane) nil))
+ (adjust-cache pane))
+ (fill-cache pane)
+ (display-cache pane))
(defgeneric full-redisplay (pane))
+(defmethod full-redisplay ((pane climacs-pane))
+ (setf (full-redisplay-p pane) t))
\ No newline at end of file
Index: climacs/syntax.lisp
diff -u climacs/syntax.lisp:1.25 climacs/syntax.lisp:1.26
--- climacs/syntax.lisp:1.25 Sat Jan 15 20:50:43 2005
+++ climacs/syntax.lisp Mon Jan 17 08:10:19 2005
@@ -40,7 +40,7 @@
(define-presentation-method accept
((type syntax) stream (view textual-view) &key)
- (multiple-value-bind (pathname success string)
+ (multiple-value-bind (object success string)
(complete-input stream
(lambda (so-far action)
(complete-from-possibilities
@@ -49,8 +49,8 @@
:value-key #'cdr))
:partial-completers '(#\Space)
:allow-any-input t)
- (declare (ignore success))
- (or pathname string)))
+ (declare (ignore success string))
+ object))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
More information about the Climacs-cvs
mailing list