climacs-cvs

climacs-cvs@common-lisp.net

847 discussions

[climacs-cvs] CVS climacs
by thenriksen 15 Dec '07

15 Dec '07

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv25934 Modified Files: window-commands.lisp text-syntax.lisp search-commands.lisp misc-commands.lisp Log Message: Added my copyright statement to a bunch of files. --- /project/climacs/cvsroot/climacs/window-commands.lisp 2007/12/10 21:31:09 1.13 +++ /project/climacs/cvsroot/climacs/window-commands.lisp 2007/12/15 10:17:11 1.14 @@ -8,6 +8,8 @@ ;;; Matthieu Villeneuve (matthieu.villeneuve(a)free.fr) ;;; (c) copyright 2005 by ;;; Aleksandar Bakic (a_bakic(a)yahoo.com) +;;; (c) copyright 2007 by +;;; Troels Henriksen (athas(a)sigkill.dk) ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Library General Public --- /project/climacs/cvsroot/climacs/text-syntax.lisp 2007/12/08 08:55:06 1.14 +++ /project/climacs/cvsroot/climacs/text-syntax.lisp 2007/12/15 10:17:11 1.15 @@ -4,6 +4,8 @@ ;;; Robert Strandh (strandh(a)labri.fr) ;;; (c) copyright 2005 by ;;; Matthieu Villeneuve (matthieu.villeneuve(a)free.fr) +;;; (c) copyright 2007 by +;;; Troels Henriksen (athas(a)sigkill.dk) ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Library General Public --- /project/climacs/cvsroot/climacs/search-commands.lisp 2007/12/08 08:55:06 1.17 +++ /project/climacs/cvsroot/climacs/search-commands.lisp 2007/12/15 10:17:11 1.18 @@ -8,6 +8,8 @@ ;;; Matthieu Villeneuve (matthieu.villeneuve(a)free.fr) ;;; (c) copyright 2005 by ;;; Aleksandar Bakic (a_bakic(a)yahoo.com) +;;; (c) copyright 2007 by +;;; Troels Henriksen (athas(a)sigkill.dk) ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Library General Public --- /project/climacs/cvsroot/climacs/misc-commands.lisp 2007/12/08 08:55:06 1.29 +++ /project/climacs/cvsroot/climacs/misc-commands.lisp 2007/12/15 10:17:11 1.30 @@ -8,6 +8,8 @@ ;;; Matthieu Villeneuve (matthieu.villeneuve(a)free.fr) ;;; (c) copyright 2005 by ;;; Aleksandar Bakic (a_bakic(a)yahoo.com) +;;; (c) copyright 2007 by +;;; Troels Henriksen (athas(a)sigkill.dk) ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Library General Public

1 0

[climacs-cvs] CVS climacs
by rstrandh 15 Dec '07

15 Dec '07

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv27849 Modified Files: gui.lisp Log Message: Fixed a double negative. --- /project/climacs/cvsroot/climacs/gui.lisp 2007/12/13 08:57:08 1.244 +++ /project/climacs/cvsroot/climacs/gui.lisp 2007/12/15 07:22:50 1.245 @@ -405,7 +405,7 @@ "Return some view, any view, preferable one that is not currently displayed in any window." (or (find-if-not #'(lambda (view) - (not (view-on-display *esa-instance* view))) + (view-on-display *esa-instance* view)) (views *esa-instance*)) (any-view)))

1 0

[climacs-cvs] CVS climacs
by thenriksen 13 Dec '07

13 Dec '07

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv328 Modified Files: core.lisp Log Message: Set the name of a buffer to the name of the file. In general, "buffer names" are pretty informally handled everywhere. At least they're no longer all called *scratch*, though. --- /project/climacs/cvsroot/climacs/core.lisp 2007/12/13 19:09:39 1.19 +++ /project/climacs/cvsroot/climacs/core.lisp 2007/12/13 19:28:16 1.20 @@ -341,7 +341,8 @@ (current-view) view (syntax view) (make-syntax-for-view view (syntax-class-name-for-filepath filepath)) (file-write-time buffer) (file-write-date filepath) - (needs-saving buffer) nil) + (needs-saving buffer) nil + (name buffer) (filepath-filename filepath)) (evaluate-attribute-line view) (setf (filepath buffer) filepath (read-only-p buffer) readonlyp)

1 0

[climacs-cvs] CVS climacs
by thenriksen 13 Dec '07

13 Dec '07

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv28879 Modified Files: core.lisp Log Message: Fixed memory creep issue. --- /project/climacs/cvsroot/climacs/core.lisp 2007/12/12 23:44:42 1.18 +++ /project/climacs/cvsroot/climacs/core.lisp 2007/12/13 19:09:39 1.19 @@ -87,6 +87,11 @@ (filepath (buffer view)) (needs-saving (buffer view)))) +(defun dummy-buffer () + "Create a dummy buffer object for use when killing views, to +prevent increasing memory usage." + (make-instance 'drei-buffer)) + (defgeneric kill-view (view) (:documentation "Remove `view' from the Climacs specified in `*esa-instance*'. If `view' is currently displayed in a window, @@ -106,6 +111,11 @@ (return-from kill-view nil))))) (save-buffer (buffer view))) (setf views (remove view views)) + ;; If we don't change the buffer of the view, a reference to the + ;; view will be kept in the buffer, and the view will thus not be + ;; garbage-collected. So create a circular reference structure + ;; that can be garbage-collected instead. + (setf (buffer view) (dummy-buffer)) (full-redisplay (current-window)) (current-view)))

1 0

[climacs-cvs] CVS climacs
by thenriksen 13 Dec '07

13 Dec '07

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv24293 Modified Files: gui.lisp Log Message: Added "typeout stream" idea that redirects *standard-output* to a typeout window. Also include commands defined in buffer-table. --- /project/climacs/cvsroot/climacs/gui.lisp 2007/12/11 23:42:15 1.243 +++ /project/climacs/cvsroot/climacs/gui.lisp 2007/12/13 08:57:08 1.244 @@ -225,6 +225,7 @@ (make-command-table 'global-climacs-table :errorp nil :inherit-from '(base-table + buffer-table pane-table window-table development-table @@ -253,14 +254,20 @@ (%command-table :initform (make-instance 'climacs-command-table :name 'climacs-dispatching-table) :accessor find-applicable-command-table - :accessor frame-command-table)) + :accessor frame-command-table) + (%output-stream :accessor output-stream + :initform nil + :initarg :output-stream)) (:menu-bar nil) (:panes (climacs-window (let* ((*esa-instance* *application-frame*) (climacs-pane (make-pane 'climacs-pane :active t)) (info-pane (make-pane 'climacs-info-pane - :master-pane climacs-pane))) + :master-pane climacs-pane))) + (unless (output-stream *esa-instance*) + (setf (output-stream *esa-instance*) + (make-typeout-stream *application-frame* "*standard-output*"))) (setf (windows *application-frame*) (list climacs-pane) (views *application-frame*) (list (view climacs-pane))) (vertically () @@ -285,7 +292,9 @@ prompt) :bindings ((*default-target-creator* *climacs-target-creator*) (*drei-instance* (esa-current-window frame)) - (*previous-command* (previous-command *drei-instance*)))) + (*previous-command* (previous-command *drei-instance*)) + (*standard-output* (or (output-stream frame) + *terminal-io*)))) (defmethod frame-standard-input ((frame climacs)) (get-frame-pane frame 'minibuffer)) @@ -625,10 +634,12 @@ (activate-window pane) new-pane)))) -(defun make-typeout-constellation (&optional label) +(defun make-typeout-constellation (&key label pane) (let* ((typeout-pane - (make-pane 'typeout-pane :foreground *foreground-color* :background *background-color* - :width 900 :height 400 :display-time nil :name label)) + (or pane + (make-pane 'typeout-pane :foreground *foreground-color* + :background *background-color* + :width 900 :height 400 :display-time nil :name label))) (label (make-pane 'label-pane :label label)) (vbox @@ -643,7 +654,7 @@ (with-look-and-feel-realization ((frame-manager *esa-instance*) *esa-instance*) (or (find label (windows *esa-instance*) :key #'pane-name) - (multiple-value-bind (vbox new-pane) (make-typeout-constellation label) + (multiple-value-bind (vbox new-pane) (make-typeout-constellation :label label) (let* ((current-window pane) (constellation-root (find-parent current-window))) (push new-pane (windows *esa-instance*)) @@ -667,7 +678,6 @@ (third (third children))) (setf (windows *esa-instance*) (delete window (windows *esa-instance*))) - (setf *standard-output* (car (windows *esa-instance*))) (sheet-disown-child box other) (sheet-adopt-child parent other) (sheet-disown-child parent box) @@ -687,10 +697,103 @@ (setf (windows *esa-instance*) (append (rest (windows *esa-instance*)) (list (esa-current-window *esa-instance*))))) - (activate-window (esa-current-window *esa-instance*)) - (setf *standard-output* (esa-current-window *esa-instance*))) + (activate-window (esa-current-window *esa-instance*))) ;;; For the ESA help functions. (defmethod help-stream ((frame climacs) title) (typeout-window (format nil "~10T~A" title))) + +;;; An implementation of the Gray streams protocol that uses a Climacs +;;; typeout pane to draw the output. + +(defclass typeout-stream (fundamental-character-output-stream) + ((%typeout-pane :accessor typeout-pane + :initform nil + :initarg :typeout-pane + :documentation "The typeout pane that output +will be performed on.") + (%climacs :reader climacs-instance + :initform (error "Must provide a Climacs instance for typeout streams") + :initarg :climacs) + (%label :reader label + :initform (error "A typeout stream must have a label") + :initarg :label)) + (:documentation "An output stream that performs output on +a (single) Climacs typeout pane. If the typeout pane is deleted +manually by the user, the stream will recreate it the next time +output is performed.")) + +(defmethod initialize-instance :after ((stream typeout-stream) &rest args) + (declare (ignore args)) + (setf (typeout-pane stream) + (with-look-and-feel-realization ((frame-manager (climacs-instance stream)) + (climacs-instance stream)) + (make-pane 'typeout-pane :foreground *foreground-color* + :background *background-color* + :width 900 :height 400 :display-time nil :name (label stream))))) + +(defgeneric ensure-typeout-pane-for-stream (stream) + (:documentation "Ensure that `stream' has a typeout pane that +it can display output to, and that this pane is on display.")) + +(defmethod ensure-typeout-pane-for-stream ((stream typeout-stream)) + (with-look-and-feel-realization ((frame-manager (climacs-instance stream)) + (climacs-instance stream)) + (unless (member (typeout-pane stream) (windows (climacs-instance stream))) + (setf (sheet-parent (typeout-pane stream)) nil) + (multiple-value-bind (vbox new-pane) (make-typeout-constellation :pane (typeout-pane stream) + :label (label stream)) + (let* ((current-window (current-window)) + (constellation-root (find-parent current-window))) + (push new-pane (windows *esa-instance*)) + (other-window) + (replace-constellation constellation-root vbox t) + (full-redisplay current-window)))))) + +(defmethod stream-write-char ((stream typeout-stream) char) + (ensure-typeout-pane-for-stream stream) + (stream-write-char (typeout-pane stream) char)) + +(defmethod stream-line-column ((stream typeout-stream)) + (ensure-typeout-pane-for-stream stream) + (stream-line-column (typeout-pane stream))) + +(defmethod stream-start-line-p ((stream typeout-stream)) + (ensure-typeout-pane-for-stream stream) + (stream-start-line-p (typeout-pane stream))) + +(defmethod stream-write-string ((stream typeout-stream) string &optional (start 0) end) + (ensure-typeout-pane-for-stream stream) + (stream-write-string (typeout-pane stream) string start end)) + +(defmethod stream-terpri ((stream typeout-stream)) + (ensure-typeout-pane-for-stream stream) + (stream-terpri (typeout-pane stream))) + +(defmethod stream-fresh-line ((stream typeout-stream)) + (ensure-typeout-pane-for-stream stream) + (stream-fresh-line (typeout-pane stream))) + +(defmethod stream-finish-output ((stream typeout-stream)) + (ensure-typeout-pane-for-stream stream) + (stream-finish-output (typeout-pane stream))) + +(defmethod stream-force-output ((stream typeout-stream)) + (ensure-typeout-pane-for-stream stream) + (stream-force-output (typeout-pane stream))) + +(defmethod stream-clear-output ((stream typeout-stream)) + (ensure-typeout-pane-for-stream stream) + (stream-clear-output (typeout-pane stream))) + +(defmethod stream-advance-to-column ((stream typeout-stream) (column integer)) + (ensure-typeout-pane-for-stream stream) + (stream-advance-to-column (typeout-pane stream) column)) + +(defmethod interactive-stream-p ((stream typeout-stream)) + (ensure-typeout-pane-for-stream stream) + (interactive-stream-p (typeout-pane stream))) + +(defun make-typeout-stream (climacs label) + (make-instance 'typeout-stream :climacs climacs :label label))

1 0

[climacs-cvs] CVS climacs
by thenriksen 13 Dec '07

13 Dec '07

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv28020 Modified Files: core.lisp Log Message: Tell newly loaded files that they do not need to be saved. --- /project/climacs/cvsroot/climacs/core.lisp 2007/12/11 23:19:45 1.17 +++ /project/climacs/cvsroot/climacs/core.lisp 2007/12/12 23:44:42 1.18 @@ -330,7 +330,8 @@ (setf (offset (point buffer)) (offset (point view)) (current-view) view (syntax view) (make-syntax-for-view view (syntax-class-name-for-filepath filepath)) - (file-write-time buffer) (file-write-date filepath)) + (file-write-time buffer) (file-write-date filepath) + (needs-saving buffer) nil) (evaluate-attribute-line view) (setf (filepath buffer) filepath (read-only-p buffer) readonlyp)

1 0

[climacs-cvs] CVS climacs
by thenriksen 12 Dec '07

12 Dec '07

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv9810 Modified Files: gui.lisp Log Message: Made Climacs respect typeout panes a little more. There's no reason to be sour just because the pane you happen to grab doesn't have a view. --- /project/climacs/cvsroot/climacs/gui.lisp 2007/12/11 23:19:45 1.242 +++ /project/climacs/cvsroot/climacs/gui.lisp 2007/12/11 23:42:15 1.243 @@ -96,6 +96,7 @@ (let ((window-displaying-view (find-if #'(lambda (other-pane) (and (not (eq other-pane pane)) + (typep other-pane 'climacs-pane) (eq (view other-pane) view))) (windows (pane-frame pane)))) (old-view-active (active (view pane)))) @@ -235,9 +236,11 @@ ()) (defmethod command-table-inherit-from ((table climacs-command-table)) - (append (view-command-tables (current-view)) + (append (when (typep (current-window) 'climacs-pane) + (view-command-tables (current-view))) '(global-climacs-table) - (when (use-editor-commands-p (current-view)) + (when (and (typep (current-window) 'climacs-pane) + (use-editor-commands-p (current-view))) '(editor-table)) (call-next-method))) @@ -312,13 +315,15 @@ instance." (eq window (esa-current-window (pane-frame window)))) -(defun ensure-only-view-active (climacs view) +(defun ensure-only-view-active (climacs &optional view) "Ensure that `view' is the only view of `climacs' that is +active. `View' may be NIL, in which case no view is set as active." (dolist (other-view (views climacs)) (unless (eq other-view view) (setf (active other-view) nil))) - (setf (active view) t)) + (unless (null view) + (setf (active view) t))) (defmethod (setf views) :around (new-value (frame climacs)) ;; If any windows show a view that no longer exists in the @@ -379,20 +384,28 @@ "Return some view on display." (view (esa-current-window *application-frame*))) +(defun view-on-display (climacs view) + "Return true if `view' is on display in a window of `climacs', +false otherwise." + (member view (remove-if-not #'(lambda (window) + (typep window 'climacs-pane)) + (windows climacs)) + :key #'view)) + (defun any-preferably-undisplayed-view () "Return some view, any view, preferable one that is not currently displayed in any window." - (or (find-if #'(lambda (view) - (not (member view (windows *esa-instance*) :key #'view))) - (views *esa-instance*)) + (or (find-if-not #'(lambda (view) + (not (view-on-display *esa-instance* view))) + (views *esa-instance*)) (any-view))) (defun any-undisplayed-view () "Return some view, any view, as long as it is not currently displayed in any window. If necessary, clone a view on display." - (or (find-if #'(lambda (view) - (not (member view (windows *esa-instance*) :key #'view))) - (views *esa-instance*)) + (or (find-if-not #'(lambda (view) + (view-on-display *esa-instance* view)) + (views *esa-instance*)) (clone-view-for-climacs *esa-instance* (any-view)))) (define-presentation-type read-only ()) @@ -509,8 +522,9 @@ (error "Cannot set unknown window to be active window")) (setf (windows climacs) (cons window (remove window (windows climacs))))) - (when (typep window 'climacs-pane) - (ensure-only-view-active climacs (view window))))) + (ensure-only-view-active + climacs (when (typep window 'climacs-pane) + (view window))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

[climacs-cvs] CVS climacs
by thenriksen 12 Dec '07

12 Dec '07

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv5034 Modified Files: core.lisp gui.lisp Log Message: Made typeout windows work again. Now Climacs doesn't primarily deal with the "active view" any more (that was a mistake on my part, typeout windows do not have views, hence this would never work) but the "active window". Not a user-visible change, but fixes typeout windows. --- /project/climacs/cvsroot/climacs/core.lisp 2007/12/08 08:55:06 1.16 +++ /project/climacs/cvsroot/climacs/core.lisp 2007/12/11 23:19:45 1.17 @@ -388,4 +388,4 @@ (error () (progn (beep) (display-message "Invalid answer") (return-from frame-exit nil))))) - (call-next-method))) \ No newline at end of file + (call-next-method))) --- /project/climacs/cvsroot/climacs/gui.lisp 2007/12/10 21:31:09 1.241 +++ /project/climacs/cvsroot/climacs/gui.lisp 2007/12/11 23:19:45 1.242 @@ -97,7 +97,8 @@ (find-if #'(lambda (other-pane) (and (not (eq other-pane pane)) (eq (view other-pane) view))) - (windows (pane-frame pane))))) + (windows (pane-frame pane)))) + (old-view-active (active (view pane)))) (cond ((not (member view (views (pane-frame pane)))) (restart-case (error 'unknown-view :view view) (add-to-view-list () @@ -121,7 +122,9 @@ (pane-frame window-displaying-view) view))) (cancel () :report "Cancel the setting of the windows view and just return"))) - (t (call-next-method))))) + (t (call-next-method))) + (when old-view-active + (ensure-only-view-active (pane-frame pane) view)))) (defmethod (setf view) :before ((view drei-view) (pane climacs-pane)) (with-accessors ((views views)) (pane-frame pane) @@ -299,30 +302,43 @@ (setf (buffer (current-view (esa-current-window application-frame))) new-buffer)) +(defmethod (setf windows) :after (new-val (climacs climacs)) + ;; Ensures that we don't end up with two views that both believe + ;; they are active. + (activate-window (esa-current-window climacs))) + +(defun current-window-p (window) + "Return true if `window' is the current window of its Climacs +instance." + (eq window (esa-current-window (pane-frame window)))) + +(defun ensure-only-view-active (climacs view) + "Ensure that `view' is the only view of `climacs' that is +active." + (dolist (other-view (views climacs)) + (unless (eq other-view view) + (setf (active other-view) nil))) + (setf (active view) t)) + (defmethod (setf views) :around (new-value (frame climacs)) ;; If any windows show a view that no longer exists in the ;; view-list, make them show something else. The view-list might be - ;; destructively updated, so copy it for safekeeping. + ;; destructively updated, so copy it for safekeeping. Also make sure + ;; only one view thinks that it's active. (with-accessors ((views views)) frame (let* ((old-views (copy-list views)) (removed-views (set-difference old-views (call-next-method) :test #'eq))) - (dolist (window (windows frame)) - (when (member (view window) removed-views :test #'eq) + (when (and (typep window 'climacs-pane) + (member (view window) removed-views :test #'eq)) (handler-case (setf (view window) (any-preferably-undisplayed-view)) (view-already-displayed () - (delete-window window))))) - ;; If the active view was removed, we have to designate a new - ;; active view. - (if (find-if #'active removed-views) - (activate-view frame (any-displayed-view)) - ;; Else, we just have to make sure that the active view is - ;; still number one in the list. - (let ((active-view (find-if #'active views))) - (unless (eq active-view (first views)) - (setf views (cons active-view (delete active-view views))))))))) + (delete-window window))))))) + (ensure-only-view-active + frame (when (typep (esa-current-window frame) 'climacs-pane) + (view (esa-current-window frame))))) (defmethod (setf views) :after ((new-value null) (frame climacs)) ;; You think you can remove all views? I laught at your silly @@ -330,11 +346,6 @@ (setf (views frame) (list (make-new-view-for-climacs frame 'textual-drei-syntax-view)))) -(defmethod (setf windows) :after (new-value (frame climacs)) - ;; It may be that the window holding the active view has been - ;; removed, if so, we must activate another view. - (activate-view frame (any-displayed-view))) - (defun make-view-subscript-generator (climacs) #'(lambda (name) (1+ (reduce #'max (remove name (views climacs) @@ -346,8 +357,8 @@ "Clone `view' and add it to `climacs's list of views." (let ((new-view (apply #'clone-view view :subscript-generator (make-view-subscript-generator climacs) - :active nil :syntax (make-syntax-for-view view (class-of (syntax view))) - initargs))) + :active nil initargs))) + (setf (syntax new-view) (make-syntax-for-view new-view (class-of (syntax view)))) (push new-view (views climacs)) new-view)) @@ -366,7 +377,7 @@ (defun any-displayed-view () "Return some view on display." - (view (first (windows *application-frame*)))) + (view (esa-current-window *application-frame*))) (defun any-preferably-undisplayed-view () "Return some view, any view, preferable one that is not @@ -485,13 +496,21 @@ 'base-table '((#\l :control))) -(defun activate-view (climacs active-view) - "Set `view' to be the active view for `climacs'." +(defun activate-window (window) + "Set `window' to be the active window for its Climacs +instance. `Window' must already be recognized by the Climacs +instance." ;; Ensure that only one pane can be active. - (dolist (view (views climacs)) - (unless (eq active-view view) - (setf (active view) nil))) - (setf (active active-view) t)) + (let ((climacs (pane-frame window))) + (unless (current-window-p window) + (when (typep (esa-current-window climacs) 'climacs-pane) + (setf (active (esa-current-window climacs)) nil)) + (unless (member window (windows climacs)) + (error "Cannot set unknown window to be active window")) + (setf (windows climacs) + (cons window (remove window (windows climacs))))) + (when (typep window 'climacs-pane) + (ensure-only-view-active climacs (view window))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -589,7 +608,7 @@ (replace-constellation constellation-root vbox vertically-p) (full-redisplay current-window) (full-redisplay new-pane) - (activate-view (pane-frame pane) pane) + (activate-window pane) new-pane)))) (defun make-typeout-constellation (&optional label) @@ -653,9 +672,9 @@ (remove pane (windows *esa-instance*)))) (setf (windows *esa-instance*) (append (rest (windows *esa-instance*)) - (list (first (windows *esa-instance*)))))) - (activate-view *esa-instance* (view (first (windows *esa-instance*)))) - (setf *standard-output* (first (windows *esa-instance*)))) + (list (esa-current-window *esa-instance*))))) + (activate-window (esa-current-window *esa-instance*)) + (setf *standard-output* (esa-current-window *esa-instance*))) ;;; For the ESA help functions.

1 0

[climacs-cvs] CVS climacs
by thenriksen 11 Dec '07

11 Dec '07

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv13351 Modified Files: climacs-lisp-syntax.lisp climacs-lisp-syntax-commands.lisp Log Message: I broke the Swank-using code, now unbroke it. --- /project/climacs/cvsroot/climacs/climacs-lisp-syntax.lisp 2007/12/08 08:55:06 1.6 +++ /project/climacs/cvsroot/climacs/climacs-lisp-syntax.lisp 2007/12/11 18:46:53 1.7 @@ -286,7 +286,7 @@ (form-to-object syntax token :read t :package (package-at-mark syntax mark)) - syntax m) + view m) (show-note-counts notes (second result)) (when (not (null notes)) (show-notes notes (name view) --- /project/climacs/cvsroot/climacs/climacs-lisp-syntax-commands.lisp 2007/12/08 08:55:06 1.6 +++ /project/climacs/cvsroot/climacs/climacs-lisp-syntax-commands.lisp 2007/12/11 18:46:53 1.7 @@ -78,12 +78,12 @@ () "Compile and load the current file. -Compiler notes will be displayed in a seperate buffer." - (compile-file-interactively (current-buffer) t)) +Compiler notes will be displayed in a seperate view." + (compile-file-interactively (current-view) t)) (define-command (com-compile-file :name t :command-table climacs-lisp-table) () - "Compile the file open in the current buffer. + "Compile the file open in the current view. This command does not load the file after it has been compiled." (compile-file-interactively (current-view) nil))

1 0

[climacs-cvs] CVS climacs
by thenriksen 10 Dec '07

10 Dec '07

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv24612 Modified Files: gui.lisp window-commands.lisp Log Message: Make Climacs support nonstandard views somewhat. Easier than I expected, so bugs probably still abound. There's not really much UI candy to make nonstandard views very useful currently, consider this to be proof of concept support. --- /project/climacs/cvsroot/climacs/gui.lisp 2007/12/08 08:55:06 1.240 +++ /project/climacs/cvsroot/climacs/gui.lisp 2007/12/10 21:31:09 1.241 @@ -56,9 +56,11 @@ (:default-initargs :view (make-instance 'textual-drei-syntax-view :buffer (make-instance 'climacs-buffer)) - :command-table (find-command-table 'global-climacs-table) :width 900 :height 400)) +(defmethod command-table ((pane climacs-pane)) + (command-table (pane-frame pane))) + (define-condition view-setting-error (error) ((%view :accessor view :initarg :view @@ -125,9 +127,6 @@ (with-accessors ((views views)) (pane-frame pane) (full-redisplay pane))) -(defmethod command-table ((drei climacs-pane)) - (command-table (pane-frame drei))) - (defclass typeout-pane (application-pane esa-pane-mixin) ((%active :accessor active :initform nil @@ -181,10 +180,13 @@ ;;; Basic command tables follow. The global command table, ;;; `global-climacs-table', inherits from these, so they should not ;;; contain any overly syntax-specific commands. The idea is that it -;;; should be safe for any syntax to inherit its command-table from -;;; `global-climacs-table' (so the usual movement, search and -;;; navigation-commands are available), without risking adding alien -;;; commands that require the buffer to be in a specific syntax. +;;; should always be safe to invoke commands from these tables, +;;; without risking adding alien commands that require the current +;;; window to contain a specific type of view or syntax. In general, +;;; the Climacs frame has a special command table of type +;;; `climacs-command-table' (that's not its name) that selectively +;;; inherits from view-specific tables and the `global-climacs-table' +;;; based on the current window and view. ;;; Basic functionality (make-command-table 'base-table :errorp nil) @@ -216,12 +218,24 @@ development-table climacs-help-table)) +(make-command-table 'global-climacs-table + :errorp nil + :inherit-from '(base-table + pane-table + window-table + development-table + climacs-help-table + global-esa-table + esa-io-table)) + (defclass climacs-command-table (standard-command-table) ()) (defmethod command-table-inherit-from ((table climacs-command-table)) - (append (when (current-syntax) (list (command-table (current-syntax)))) + (append (view-command-tables (current-view)) '(global-climacs-table) + (when (use-editor-commands-p (current-view)) + '(editor-table)) (call-next-method))) (define-application-frame climacs (esa-frame-mixin @@ -232,20 +246,8 @@ (%kill-ring :initform (make-instance 'kill-ring :max-size 7) :accessor kill-ring) (%command-table :initform (make-instance 'climacs-command-table :name 'climacs-dispatching-table) - :accessor find-applicable-command-table)) - (:command-table (global-climacs-table - :inherit-from (esa-io-table - keyboard-macro-table - climacs-help-table - base-table - buffer-table - case-table - development-table - info-table - pane-table - window-table - editor-table - global-esa-table))) + :accessor find-applicable-command-table + :accessor frame-command-table)) (:menu-bar nil) (:panes (climacs-window @@ -391,13 +393,52 @@ ((type modified) record stream state) nil) +(defgeneric display-view-info-to-info-pane (info-pane master-pane view) + (:documentation "Display interesting information about +`view' (which is in `master-pane') to `info-pane'.")) + +(defmethod display-view-info-to-info-pane ((info-pane climacs-info-pane) + (master-pane climacs-pane) + (view drei-syntax-view)) + (with-text-family (info-pane :sans-serif) + (display-syntax-name (syntax view) info-pane :view view))) + +(defmethod display-view-info-to-info-pane ((info-pane climacs-info-pane) + (master-pane climacs-pane) + (view textual-drei-syntax-view)) + (let ((point (point view)) + (bot (bot view)) + (top (top view)) + (size (size (buffer view)))) + (format info-pane " ~A " + (cond ((and (mark= size bot) + (mark= 0 top)) + "") + ((mark= size bot) + "Bot") + ((mark= 0 top) + "Top") + (t (format nil "~a%" + (round (* 100 (/ (offset top) + size))))))) + (when *show-info-pane-mark-position* + (format info-pane "(~A,~A) " + (1+ (line-number point)) + (column-number point))) + (princ #\( info-pane) + (call-next-method) + (format info-pane "~{~:[~*~; ~A~]~}" (list + (overwrite-mode view) + "Ovwrt" + (auto-fill-mode view) + "Fill" + (isearch-mode master-pane) + "Isearch")) + (princ #\) info-pane))) + (defun display-info (frame pane) (let* ((master-pane (master-pane pane)) - (view (view master-pane)) - (size (size (buffer view))) - (top (top view)) - (bot (bot view)) - (point (point view))) + (view (view master-pane))) (princ " " pane) (with-output-as-presentation (pane view 'read-only) (princ (cond @@ -417,32 +458,7 @@ (format pane "~A" (subscripted-name view))) ;; FIXME: bare 25. (format pane "~V@T" (max (- 25 (length (subscripted-name view))) 1))) - (format pane " ~A " - (cond ((and (mark= size bot) - (mark= 0 top)) - "") - ((mark= size bot) - "Bot") - ((mark= 0 top) - "Top") - (t (format nil "~a%" - (round (* 100 (/ (offset top) - size))))))) - (when *show-info-pane-mark-position* - (format pane "(~A,~A) " - (1+ (line-number point)) - (column-number point))) - (with-text-family (pane :sans-serif) - (princ #\( pane) - (display-syntax-name (syntax view) pane :view view) - (format pane "~{~:[~*~; ~A~]~}" (list - (overwrite-mode view) - "Ovwrt" - (auto-fill-mode view) - "Fill" - (isearch-mode master-pane) - "Isearch")) - (princ #\) pane)) + (display-view-info-to-info-pane pane master-pane view) (with-text-family (pane :sans-serif) (princ (if (recordingp frame) "Def" --- /project/climacs/cvsroot/climacs/window-commands.lisp 2007/12/08 08:55:06 1.12 +++ /project/climacs/cvsroot/climacs/window-commands.lisp 2007/12/10 21:31:09 1.13 @@ -90,7 +90,8 @@ (define-command (com-switch-to-this-window :name nil :command-table window-table) ((window 'pane) (x 'integer) (y 'integer)) (other-window window) - (when (buffer-pane-p window) + (when (and (buffer-pane-p window) + (typep (view window) 'point-mark-view)) (setf (offset (point (view window))) (click-to-offset window x y))))

1 0

← Newer
1
...
5
6
7
8
9
10
11
...
85
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

climacs-cvs