- climacs-cvs@common-lisp.net - mailman3.common-lisp.net

[climacs-cvs] CVS update: climacs/gui.lisp
by dmurray＠common-lisp.net 19 Jul '05

19 Jul '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv10112 Modified Files: gui.lisp Log Message: Replaced cloned marks with (setf offsets) to retain mark identity on switching buffers/panes Date: Tue Jul 19 20:35:22 2005 Author: dmurray Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.157 climacs/gui.lisp:1.158 --- climacs/gui.lisp:1.157 Mon Jul 18 08:09:50 2005 +++ climacs/gui.lisp Tue Jul 19 20:35:22 2005 @@ -741,7 +741,7 @@ :prompt "Find File")) (buffer (make-instance 'climacs-buffer)) (pane (current-window))) - (setf (point (buffer pane)) (clone-mark (point pane))) + (setf (offset (point (buffer pane))) (offset (point pane))) (push buffer (buffers *application-frame*)) (setf (buffer (current-window)) buffer) (setf (syntax buffer) @@ -841,7 +841,7 @@ (let ((buffer (accept 'buffer :prompt "Switch to buffer")) (pane (current-window))) - (setf (point (buffer pane)) (clone-mark (point pane))) + (setf (offset (point (buffer pane))) (offset (point pane))) (setf (buffer pane) buffer) (full-redisplay pane))) @@ -1013,7 +1013,7 @@ (multiple-value-bind (vbox new-pane) (make-pane-constellation) (let* ((current-window (current-window)) (constellation-root (parent3 current-window))) - (setf (point (buffer current-window)) (clone-mark (point current-window)) + (setf (offset (point (buffer current-window))) (offset (point current-window)) (buffer new-pane) (buffer current-window) (auto-fill-mode new-pane) (auto-fill-mode current-window) (auto-fill-column new-pane) (auto-fill-column current-window)) @@ -1029,7 +1029,7 @@ (multiple-value-bind (vbox new-pane) (make-pane-constellation) (let* ((current-window (current-window)) (constellation-root (parent3 current-window))) - (setf (point (buffer current-window)) (clone-mark (point current-window)) + (setf (offset (point (buffer current-window))) (offset (point current-window)) (buffer new-pane) (buffer current-window) (auto-fill-mode new-pane) (auto-fill-mode current-window) (auto-fill-column new-pane) (auto-fill-column current-window))

1 0

[climacs-cvs] CVS update: climacs/fundamental-syntax.lisp climacs/climacs.asd climacs/packages.lisp
by rstrandh＠common-lisp.net 19 Jul '05

19 Jul '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv8941 Modified Files: climacs.asd packages.lisp Added Files: fundamental-syntax.lisp Log Message: New syntax: `fundamental' My idea is to eventually get rid of the `basic' syntax. Not only is the name not great, but the code it contains some cruft that I would like to get rid of. For instance, the cache is no longer necessary and is messy to manage anyway. In addition, the `basic' syntax is problematic with respect to factoring out the GUI part of Climacs into a separate application-independent module. That's another good reason to get rid of it. So, I would appreciate if you would please check out this new syntax and let me know how it turns out. If I hear no complaints, I'll start by making `fundamental' the default syntax, and then remove the `basic' syntax altogether. Date: Tue Jul 19 12:02:03 2005 Author: rstrandh Index: climacs/climacs.asd diff -u climacs/climacs.asd:1.31 climacs/climacs.asd:1.32 --- climacs/climacs.asd:1.31 Sun Jun 5 03:59:52 2005 +++ climacs/climacs.asd Tue Jul 19 12:02:02 2005 @@ -61,6 +61,7 @@ "delegating-buffer" "Persistent/persistent-undo" "pane" + "fundamental-syntax" "cl-syntax" "html-syntax" "prolog-syntax" Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.64 climacs/packages.lisp:1.65 --- climacs/packages.lisp:1.64 Mon May 30 11:33:39 2005 +++ climacs/packages.lisp Tue Jul 19 12:02:02 2005 @@ -142,6 +142,11 @@ #:with-undo #:url)) +(defpackage :climacs-fundamental-syntax + (:use :clim-lisp :clim :climacs-buffer :climacs-base + :climacs-syntax :flexichain :climacs-pane) + (:export)) + (defpackage :climacs-html-syntax (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-syntax :flexichain :climacs-pane))

1 0

[climacs-cvs] CVS update: climacs/gui.lisp
by rstrandh＠common-lisp.net 18 Jul '05

18 Jul '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv31484 Modified Files: gui.lisp Log Message: Renamed things that aren't Climacs specific. Moved the code for marking buffers as needing to be saved to an :after method of execute-frame-command. The previous code was not right, in that it is entirely possible for a command to modify a buffer which is not the current one. Date: Mon Jul 18 08:09:51 2005 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.156 climacs/gui.lisp:1.157 --- climacs/gui.lisp:1.156 Mon Jul 18 00:40:37 2005 +++ climacs/gui.lisp Mon Jul 18 08:09:50 2005 @@ -182,9 +182,9 @@ (#\5 :meta) (#\6 :meta) (#\7 :meta) (#\8 :meta) (#\9 :meta)) :test #'event-matches-gesture-name-p)) -(defun climacs-read-gesture () +(defun generic-read-gesture () (unless (null (remaining-keys *application-frame*)) - (return-from climacs-read-gesture + (return-from generic-read-gesture (pop (remaining-keys *application-frame*)))) (loop for gesture = (read-gesture :stream *standard-input*) until (or (characterp gesture) @@ -203,7 +203,7 @@ (push gesture (recorded-keys *application-frame*))) (return gesture)))) -(defun climacs-unread-gesture (gesture stream) +(defun generic-unread-gesture (gesture stream) (cond ((recordingp *application-frame*) (pop (recorded-keys *application-frame*)) (unread-gesture gesture :stream stream)) @@ -213,35 +213,35 @@ (unread-gesture gesture :stream stream)))) (defun read-numeric-argument (&key (stream *standard-input*)) - (let ((gesture (climacs-read-gesture))) + (let ((gesture (generic-read-gesture))) (cond ((event-matches-gesture-name-p gesture '(:keyboard #\u 512)) ; FIXME (let ((numarg 4)) - (loop for gesture = (climacs-read-gesture) + (loop for gesture = (generic-read-gesture) while (event-matches-gesture-name-p gesture '(:keyboard #\u 512)) ; FIXME do (setf numarg (* 4 numarg)) - finally (climacs-unread-gesture gesture stream)) - (let ((gesture (climacs-read-gesture))) + finally (generic-unread-gesture gesture stream)) + (let ((gesture (generic-read-gesture))) (cond ((and (characterp gesture) (digit-char-p gesture 10)) (setf numarg (- (char-code gesture) (char-code #\0))) - (loop for gesture = (climacs-read-gesture) + (loop for gesture = (generic-read-gesture) while (and (characterp gesture) (digit-char-p gesture 10)) do (setf numarg (+ (* 10 numarg) (- (char-code gesture) (char-code #\0)))) - finally (climacs-unread-gesture gesture stream) + finally (generic-unread-gesture gesture stream) (return (values numarg t)))) (t - (climacs-unread-gesture gesture stream) + (generic-unread-gesture gesture stream) (values numarg t)))))) ((meta-digit gesture) (let ((numarg (meta-digit gesture))) - (loop for gesture = (climacs-read-gesture) + (loop for gesture = (generic-read-gesture) while (meta-digit gesture) do (setf numarg (+ (* 10 numarg) (meta-digit gesture))) - finally (climacs-unread-gesture gesture stream) + finally (generic-unread-gesture gesture stream) (return (values numarg t))))) - (t (climacs-unread-gesture gesture stream) + (t (generic-unread-gesture gesture stream) (values 1 nil))))) ;;; we know the vbox pane has a scroller pane and an info @@ -276,6 +276,11 @@ (no-such-operation () (beep) (display-message "Operation unavailable for syntax")))) +(defmethod execute-frame-command :after ((frame climacs) command) + (loop for buffer in (buffers frame) + do (when (modified-p buffer) + (setf (needs-saving buffer) t)))) + (defun do-command (frame command) (execute-frame-command frame command) (setf (previous-command *standard-output*) @@ -283,10 +288,10 @@ (car command) command))) -(defun update-climacs (frame) - (let ((buffer (buffer (current-window)))) - (when (modified-p buffer) - (setf (needs-saving buffer) t))) +(defgeneric update-frame (frame) + (:method (frame) (declare (ignore frame)) nil)) + +(defmethod update-frame ((frame climacs)) (when (null (remaining-keys *application-frame*)) (setf (executingp *application-frame*) nil) (redisplay-frame-panes frame))) @@ -297,7 +302,7 @@ do (multiple-value-bind (numarg numargp) (read-numeric-argument :stream *standard-input*) (loop - (setf *current-gesture* (climacs-read-gesture)) + (setf *current-gesture* (generic-read-gesture)) (setf gestures (nconc gestures (list *current-gesture*))) (let ((item (find-gestures gestures 'global-climacs-table))) @@ -313,7 +318,7 @@ (do-command frame command) (return))) (t nil))))) - do (update-climacs frame))) + do (update-frame frame))) (defun climacs-top-level (frame &key command-parser command-unparser @@ -342,7 +347,7 @@ (abort-gesture () (display-message "Quit"))) (when maybe-error (beep)) - (update-climacs frame)) + (update-frame frame)) (return-to-climacs () nil)))))) (defmacro simple-command-loop (command-table loop-condition end-clauses) @@ -352,7 +357,7 @@ `(progn (redisplay-frame-panes *application-frame*) (loop while ,loop-condition - as ,gesture = (climacs-read-gesture) + as ,gesture = (generic-read-gesture) as ,item = (find-gestures (list ,gesture) ,command-table) do (cond ((and ,item (eq (command-menu-item-type ,item) :command)) (setf *current-gesture* ,gesture)

1 0

[climacs-cvs] CVS update: climacs/gui.lisp climacs/pane.lisp
by abakic＠common-lisp.net 18 Jul '05

18 Jul '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv2940 Modified Files: gui.lisp pane.lisp Log Message: Bug fix: coalesced two "same" execute-frame-command methods. Date: Mon Jul 18 00:40:37 2005 Author: abakic Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.155 climacs/gui.lisp:1.156 --- climacs/gui.lisp:1.155 Sun Jul 17 17:31:38 2005 +++ climacs/gui.lisp Mon Jul 18 00:40:37 2005 @@ -118,11 +118,6 @@ (defun current-window () (car (windows *application-frame*))) -(defmethod execute-frame-command :around ((frame climacs) command) - (declare (ignore command)) - (with-undo ((buffer (current-window))) - (call-next-method))) - (defmethod redisplay-frame-panes :around ((frame climacs) &rest args) (declare (ignore args)) (let ((buffers (remove-duplicates (mapcar #'buffer (windows frame))))) @@ -266,7 +261,8 @@ (defmethod execute-frame-command :around ((frame climacs) command) (handler-case - (call-next-method) + (with-undo ((buffer (current-window))) + (call-next-method)) (offset-before-beginning () (beep) (display-message "Beginning of buffer")) (offset-after-end () Index: climacs/pane.lisp diff -u climacs/pane.lisp:1.27 climacs/pane.lisp:1.28 --- climacs/pane.lisp:1.27 Wed Jun 22 20:35:59 2005 +++ climacs/pane.lisp Mon Jul 18 00:40:37 2005 @@ -93,7 +93,6 @@ :buffer buffer :offset offset :length (length sequence)) (undo-accumulate buffer)))) - (defmethod delete-buffer-range :before ((buffer undo-mixin) offset n) (unless (performing-undo buffer) (push (make-instance 'insert-record

2 1

[climacs-cvs] CVS update: climacs/base-test.lisp
by abakic＠common-lisp.net 17 Jul '05

17 Jul '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv14951 Modified Files: base-test.lisp Log Message: Test changes due to a change in whitespacep. Date: Sun Jul 17 19:20:27 2005 Author: abakic Index: climacs/base-test.lisp diff -u climacs/base-test.lisp:1.13 climacs/base-test.lisp:1.14 --- climacs/base-test.lisp:1.13 Sun Mar 13 21:51:48 2005 +++ climacs/base-test.lisp Sun Jul 17 19:20:27 2005 @@ -467,7 +467,7 @@ (not (null (whitespacep #\Tab))) (not (null (whitespacep " "))) (not (null (whitespacep #\Null)))) - nil nil t t nil nil) + nil t t t nil nil) (defmultitest forward-to-word-boundary.test-1 (let ((buffer (make-instance %%buffer))) @@ -953,8 +953,7 @@ (values (offset m) (buffer-sequence buffer 0 (size buffer))))) - 1 " -climacs ") + 0 "climacs ") (defmultitest fill-line.test-1 (let ((buffer (make-instance %%buffer)))

1 0

[climacs-cvs] CVS update: climacs/gui.lisp
by rstrandh＠common-lisp.net 17 Jul '05

17 Jul '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv7636 Modified Files: gui.lisp Log Message: Reassign *standard-input* when the current pane changes, otherwise the concept of previous-command (which is per-pane) does not make sense. Date: Sun Jul 17 17:31:39 2005 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.154 climacs/gui.lisp:1.155 --- climacs/gui.lisp:1.154 Sun Jul 17 14:40:19 2005 +++ climacs/gui.lisp Sun Jul 17 17:31:38 2005 @@ -327,7 +327,7 @@ (setf windows (list (find-climacs-pane (find-pane-named frame 'win)))) (push (buffer (car windows)) (buffers frame)) (let ((*standard-output* (car windows)) - (*standard-input* (find-pane-named frame 'int)) + (*standard-input* (frame-standard-input frame)) (*print-pretty* nil) (*abort-gestures* '((:keyboard #\g 512)))) (redisplay-frame-panes frame :force-p t) @@ -1017,6 +1017,7 @@ (auto-fill-mode new-pane) (auto-fill-mode current-window) (auto-fill-column new-pane) (auto-fill-column current-window)) (push new-pane (windows *application-frame*)) + (setf *standard-output* new-pane) (replace-constellation constellation-root vbox t) (full-redisplay current-window) (full-redisplay new-pane))))) @@ -1032,6 +1033,7 @@ (auto-fill-mode new-pane) (auto-fill-mode current-window) (auto-fill-column new-pane) (auto-fill-column current-window)) (push new-pane (windows *application-frame*)) + (setf *standard-output* new-pane) (replace-constellation constellation-root vbox nil) (full-redisplay current-window) (full-redisplay new-pane))))) @@ -1039,13 +1041,16 @@ (define-named-command com-other-window () (setf (windows *application-frame*) (append (cdr (windows *application-frame*)) - (list (car (windows *application-frame*)))))) + (list (car (windows *application-frame*))))) + (setf *standard-output* (car (windows *application-frame*)))) (define-named-command com-single-window () (loop until (null (cdr (windows *application-frame*))) do (rotatef (car (windows *application-frame*)) (cadr (windows *application-frame*))) - (com-delete-window))) + (com-delete-window)) + (setf *standard-output* (car (windows *application-frame*)))) + (define-named-command com-delete-window () (unless (null (cdr (windows *application-frame*))) @@ -1061,6 +1066,7 @@ (second (second children)) (third (third children))) (pop (windows *application-frame*)) + (setf *standard-output* (car (windows *application-frame*))) (sheet-disown-child box other) (sheet-disown-child parent box) (sheet-adopt-child parent other)

1 0

[climacs-cvs] CVS update: climacs/gui.lisp
by rstrandh＠common-lisp.net 17 Jul '05

17 Jul '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv28181 Modified Files: gui.lisp Log Message: factored out process-gestures from climacs-top-level Date: Sun Jul 17 14:40:19 2005 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.153 climacs/gui.lisp:1.154 --- climacs/gui.lisp:1.153 Sun Jul 17 14:31:55 2005 +++ climacs/gui.lisp Sun Jul 17 14:40:19 2005 @@ -295,6 +295,30 @@ (setf (executingp *application-frame*) nil) (redisplay-frame-panes frame))) +(defun process-gestures (frame) + (loop + for gestures = '() + do (multiple-value-bind (numarg numargp) + (read-numeric-argument :stream *standard-input*) + (loop + (setf *current-gesture* (climacs-read-gesture)) + (setf gestures + (nconc gestures (list *current-gesture*))) + (let ((item (find-gestures gestures 'global-climacs-table))) + (cond + ((not item) + (beep) (return)) + ((eq (command-menu-item-type item) :command) + (let ((command (command-menu-item-value item))) + (unless (consp command) + (setf command (list command))) + (setf command (substitute-numeric-argument-marker command numarg)) + (setf command (substitute-numeric-argument-p command numargp)) + (do-command frame command) + (return))) + (t nil))))) + do (update-climacs frame))) + (defun climacs-top-level (frame &key command-parser command-unparser partial-command-parser prompt) @@ -307,47 +331,23 @@ (*print-pretty* nil) (*abort-gestures* '((:keyboard #\g 512)))) (redisplay-frame-panes frame :force-p t) - (flet () - (flet ((process-gestures () - (loop - for gestures = '() - do (multiple-value-bind (numarg numargp) - (read-numeric-argument :stream *standard-input*) - (loop - (setf *current-gesture* (climacs-read-gesture)) - (setf gestures - (nconc gestures (list *current-gesture*))) - (let ((item (find-gestures gestures 'global-climacs-table))) - (cond - ((not item) - (beep) (return)) - ((eq (command-menu-item-type item) :command) - (let ((command (command-menu-item-value item))) - (unless (consp command) - (setf command (list command))) - (setf command (substitute-numeric-argument-marker command numarg)) - (setf command (substitute-numeric-argument-p command numargp)) - (do-command frame command) - (return))) - (t nil))))) - do (update-climacs frame)))) - (loop - for maybe-error = t - do (restart-case - (progn - (handler-case - (with-input-context - ('(command :command-table global-climacs-table)) - (object) - (process-gestures) - (t - (do-command frame object) - (setq maybe-error nil))) - (abort-gesture () (display-message "Quit"))) - (when maybe-error - (beep)) - (update-climacs frame)) - (return-to-climacs () nil)))))))) + (loop + for maybe-error = t + do (restart-case + (progn + (handler-case + (with-input-context + ('(command :command-table global-climacs-table)) + (object) + (process-gestures frame) + (t + (do-command frame object) + (setq maybe-error nil))) + (abort-gesture () (display-message "Quit"))) + (when maybe-error + (beep)) + (update-climacs frame)) + (return-to-climacs () nil)))))) (defmacro simple-command-loop (command-table loop-condition end-clauses) (let ((gesture (gensym))

1 0

[climacs-cvs] CVS update: climacs/gui.lisp
by rstrandh＠common-lisp.net 17 Jul '05

17 Jul '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv28103 Modified Files: gui.lisp Log Message: moved do-command and update-climacs out of climacs-top-level Date: Sun Jul 17 14:31:55 2005 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.152 climacs/gui.lisp:1.153 --- climacs/gui.lisp:1.152 Sun Jul 17 12:24:15 2005 +++ climacs/gui.lisp Sun Jul 17 14:31:55 2005 @@ -115,8 +115,8 @@ (setf (message *standard-input*) (apply #'format nil format-string format-args))) -(defmacro current-window () ; shouldn't this be an inlined function? --amb - `(car (windows *application-frame*))) +(defun current-window () + (car (windows *application-frame*))) (defmethod execute-frame-command :around ((frame climacs) command) (declare (ignore command)) @@ -280,6 +280,21 @@ (no-such-operation () (beep) (display-message "Operation unavailable for syntax")))) +(defun do-command (frame command) + (execute-frame-command frame command) + (setf (previous-command *standard-output*) + (if (consp command) + (car command) + command))) + +(defun update-climacs (frame) + (let ((buffer (buffer (current-window)))) + (when (modified-p buffer) + (setf (needs-saving buffer) t))) + (when (null (remaining-keys *application-frame*)) + (setf (executingp *application-frame*) nil) + (redisplay-frame-panes frame))) + (defun climacs-top-level (frame &key command-parser command-unparser partial-command-parser prompt) @@ -292,19 +307,7 @@ (*print-pretty* nil) (*abort-gestures* '((:keyboard #\g 512)))) (redisplay-frame-panes frame :force-p t) - (flet ((do-command (command) - (execute-frame-command frame command) - (setf (previous-command *standard-output*) - (if (consp command) - (car command) - command))) - (update-climacs () - (let ((buffer (buffer (current-window)))) - (when (modified-p buffer) - (setf (needs-saving buffer) t))) - (when (null (remaining-keys *application-frame*)) - (setf (executingp *application-frame*) nil) - (redisplay-frame-panes frame)))) + (flet () (flet ((process-gestures () (loop for gestures = '() @@ -324,10 +327,10 @@ (setf command (list command))) (setf command (substitute-numeric-argument-marker command numarg)) (setf command (substitute-numeric-argument-p command numargp)) - (do-command command) + (do-command frame command) (return))) (t nil))))) - do (update-climacs)))) + do (update-climacs frame)))) (loop for maybe-error = t do (restart-case @@ -338,12 +341,12 @@ (object) (process-gestures) (t - (do-command object) + (do-command frame object) (setq maybe-error nil))) (abort-gesture () (display-message "Quit"))) (when maybe-error (beep)) - (update-climacs)) + (update-climacs frame)) (return-to-climacs () nil)))))))) (defmacro simple-command-loop (command-table loop-condition end-clauses)

1 0

[climacs-cvs] CVS update: climacs/gui.lisp
by rstrandh＠common-lisp.net 17 Jul '05

17 Jul '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv19923 Modified Files: gui.lisp Log Message: more code factoring of GUI components Date: Sun Jul 17 12:24:15 2005 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.151 climacs/gui.lisp:1.152 --- climacs/gui.lisp:1.151 Sun Jul 17 07:07:41 2005 +++ climacs/gui.lisp Sun Jul 17 12:24:15 2005 @@ -76,13 +76,17 @@ (:default-initargs :height 20 :max-height 20 :min-height 20)) -(define-application-frame climacs () +(defclass multi-frame-mixin () ((windows :accessor windows) (buffers :initform '() :accessor buffers) (recordingp :initform nil :accessor recordingp) (executingp :initform nil :accessor executingp) (recorded-keys :initform '() :accessor recorded-keys) - (remaining-keys :initform '() :accessor remaining-keys)) + (remaining-keys :initform '() :accessor remaining-keys))) + +(define-application-frame climacs (standard-application-frame + multi-frame-mixin) + () (:panes (win (let* ((extended-pane (make-pane 'extended-pane @@ -260,6 +264,22 @@ (defun substitute-numeric-argument-p (command numargp) (substitute numargp *numeric-argument-p* command :test #'eq)) +(defmethod execute-frame-command :around ((frame climacs) command) + (handler-case + (call-next-method) + (offset-before-beginning () + (beep) (display-message "Beginning of buffer")) + (offset-after-end () + (beep) (display-message "End of buffer")) + (motion-before-beginning () + (beep) (display-message "Beginning of buffer")) + (motion-after-end () + (beep) (display-message "End of buffer")) + (no-expression () + (beep) (display-message "No expression around point")) + (no-such-operation () + (beep) (display-message "Operation unavailable for syntax")))) + (defun climacs-top-level (frame &key command-parser command-unparser partial-command-parser prompt) @@ -273,20 +293,7 @@ (*abort-gestures* '((:keyboard #\g 512)))) (redisplay-frame-panes frame :force-p t) (flet ((do-command (command) - (handler-case - (execute-frame-command frame command) - (offset-before-beginning () - (beep) (display-message "Beginning of buffer")) - (offset-after-end () - (beep) (display-message "End of buffer")) - (motion-before-beginning () - (beep) (display-message "Beginning of buffer")) - (motion-after-end () - (beep) (display-message "End of buffer")) - (no-expression () - (beep) (display-message "No expression around point")) - (no-such-operation () - (beep) (display-message "Operation unavailable for syntax"))) + (execute-frame-command frame command) (setf (previous-command *standard-output*) (if (consp command) (car command)

1 0

[climacs-cvs] CVS update: climacs/gui.lisp
by rstrandh＠common-lisp.net 17 Jul '05

17 Jul '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv32166 Modified Files: gui.lisp Log Message: A small step in towards factoring out common GUI components into a Climacs-independent module so that they can be reused in similar applications such as Gsharp. Specifically, I am trying to factor out: * the info pane (done) * the minibuffer pane (done) * the pane constellation containing an application pane (possibly within a scroller pane) and an info pane inside a vbox pane * the command loop * command processing * if possible, common commands such as C-x 0, C-x 1, C-x 2, C-x 3 Date: Sun Jul 17 07:07:42 2005 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.150 climacs/gui.lisp:1.151 --- climacs/gui.lisp:1.150 Mon Jul 11 10:47:50 2005 +++ climacs/gui.lisp Sun Jul 17 07:07:41 2005 @@ -39,15 +39,43 @@ (dabbrev-expansion-mark :initform nil) (overwrite-mode :initform nil))) +;;; a pane that displays some information about another pane (defclass info-pane (application-pane) - ((climacs-pane :initarg :climacs-pane))) + ((master-pane :initarg :master-pane)) + (:default-initargs + :background +gray85+ + :scroll-bars nil + :borders nil)) + +(defclass minibuffer-pane (application-pane) + ((message :initform nil :accessor message)) + (:default-initargs + :scroll-bars nil + :display-function 'display-minibuffer)) -(defclass minibuffer-pane (application-pane) ()) +(defun display-minibuffer (frame pane) + (declare (ignore frame)) + (with-slots (message) pane + (unless (null message) + (princ message pane) + (setf message nil)))) (defmethod stream-accept :before ((pane minibuffer-pane) type &rest args) (declare (ignore type args)) (window-clear pane)) +(defclass climacs-info-pane (info-pane) + () + (:default-initargs + :height 20 :max-height 20 :min-height 20 + :display-function 'display-info + :incremental-redisplay t)) + +(defclass climacs-minibuffer-pane (minibuffer-pane) + () + (:default-initargs + :height 20 :max-height 20 :min-height 20)) + (define-application-frame climacs () ((windows :accessor windows) (buffers :initform '() :accessor buffers) @@ -64,22 +92,14 @@ :incremental-redisplay t :display-function 'display-win)) (info-pane - (make-pane 'info-pane - :climacs-pane extended-pane - :width 900 :height 20 :max-height 20 :min-height 20 - ::background +gray85+ - :scroll-bars nil - :borders nil - :incremental-redisplay t - :display-function 'display-info))) + (make-pane 'climacs-info-pane + :master-pane extended-pane + :width 900))) (vertically () (scrolling () extended-pane) info-pane))) - (int (make-pane 'minibuffer-pane - :width 900 :height 20 :max-height 20 :min-height 20 - :display-function 'display-minibuffer - :scroll-bars nil))) + (int (make-pane 'climacs-minibuffer-pane :width 900))) (:layouts (default (vertically (:scroll-bars nil) @@ -87,18 +107,10 @@ int))) (:top-level (climacs-top-level))) -(defparameter *message* nil) - (defun display-message (format-string &rest format-args) - (setf *message* + (setf (message *standard-input*) (apply #'format nil format-string format-args))) -(defun display-minibuffer (frame pane) - (declare (ignore frame)) - (unless (null *message*) - (princ *message* pane) - (setf *message* nil))) - (defmacro current-window () ; shouldn't this be an inlined function? --amb `(car (windows *application-frame*))) @@ -116,26 +128,26 @@ (loop for buffer in buffers do (clear-modify buffer)))) -(defun climacs () +(defun climacs (&key (width 900) (height 400)) "Starts up a climacs session" - (let ((frame (make-application-frame 'climacs))) + (let ((frame (make-application-frame 'climacs :width width :height height))) (run-frame-top-level frame))) (defun display-info (frame pane) (declare (ignore frame)) - (with-slots (climacs-pane) pane - (let* ((buf (buffer climacs-pane)) + (with-slots (master-pane) pane + (let* ((buf (buffer master-pane)) (name-info (format nil " ~a ~a Syntax: ~a~a~a~a ~a" (if (needs-saving buf) "**" "--") (name buf) (name (syntax buf)) - (if (slot-value climacs-pane 'overwrite-mode) + (if (slot-value master-pane 'overwrite-mode) " Ovwrt" "") - (if (auto-fill-mode climacs-pane) + (if (auto-fill-mode master-pane) " Fill" "") - (if (isearch-mode climacs-pane) + (if (isearch-mode master-pane) " Isearch" "") (if (recordingp *application-frame*) @@ -979,15 +991,9 @@ (vbox (vertically () (scrolling () extended-pane) - (make-pane 'info-pane - :climacs-pane extended-pane - :width 900 :height 20 - :max-height 20 :min-height 20 - ::background +gray85+ - :scroll-bars nil - :borders nil - :incremental-redisplay t - :display-function 'display-info)))) + (make-pane 'climacs-info-pane + :master-pane extended-pane + :width 900)))) (values vbox extended-pane))) (define-named-command com-split-window-vertically ()

1 0