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))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;