mcclim-cvs

mcclim-cvs@common-lisp.net

1697 discussions

[mcclim-cvs] CVS mcclim/Examples
by ahefner 21 Jan '08

21 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Examples In directory clnet:/tmp/cvs-serv21511 Modified Files: font-selector.lisp Log Message: Default to the current port. --- /project/mcclim/cvsroot/mcclim/Examples/font-selector.lisp 2006/12/24 14:27:48 1.1 +++ /project/mcclim/cvsroot/mcclim/Examples/font-selector.lisp 2008/01/21 01:08:58 1.2 @@ -38,6 +38,7 @@ (define-application-frame font-selector () ((font-selector-port :initarg :font-selector-port + :initform (find-port) :accessor font-selector-port) (font-selector-text-style :accessor font-selector-text-style)) (:menu-bar nil)

1 0

[mcclim-cvs] CVS mcclim/Backends/CLX
by ahefner 21 Jan '08

21 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Backends/CLX In directory clnet:/tmp/cvs-serv21406 Modified Files: port.lisp Log Message: Patch from Nikodemus Siivola fixing warnings. --- /project/mcclim/cvsroot/mcclim/Backends/CLX/port.lisp 2008/01/17 07:11:15 1.132 +++ /project/mcclim/cvsroot/mcclim/Backends/CLX/port.lisp 2008/01/21 01:07:49 1.133 @@ -111,6 +111,8 @@ :initarg :ascent :reader fontset-width))) +(defvar *fontset* nil) + (defmethod print-object ((object fontset) stream) (format stream "#<fontset ~A>" (fontset-name object))) @@ -681,6 +683,8 @@ ;; pointer-event-buttons slot to pointer events. -- moore ;; +(defvar *clx-port*) + (defun event-handler (&key display window event-key code state mode time type width height x y root-x root-y data override-redirect-p send-event-p hint-p @@ -688,7 +692,6 @@ request first-keycode count &allow-other-keys) (declare (ignore display request first-keycode count)) - (declare (special *clx-port*)) (let ((sheet (and window (port-lookup-sheet *clx-port* window)))) (when sheet (case event-key @@ -878,7 +881,6 @@ (declare (ignore wait-function)) (let* ((*clx-port* port) (display (clx-port-display port))) - (declare (special *clx-port*)) (unless (xlib:event-listen display) (xlib:display-finish-output (clx-port-display port))) ; temporary solution @@ -959,8 +961,6 @@ (xlib:open-font display (first fonts)) (xlib:open-font display "fixed")))) -(defvar *fontset* nil) - (defmethod text-style-mapping ((port clx-port) text-style &optional character-set) (declare (ignore character-set))

1 0

[mcclim-cvs] CVS mcclim/ESA
by thenriksen 20 Jan '08

20 Jan '08

Update of /project/mcclim/cvsroot/mcclim/ESA In directory clnet:/tmp/cvs-serv12206/ESA Modified Files: esa.lisp packages.lisp Log Message: Improved support for nonbuffer views, including various bugfixes here and there, used that support to revamp Climacs' typeout panes, which in turn required some ESA changes. Stability not guaranteed, please test. --- /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2008/01/14 20:50:11 1.14 +++ /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2008/01/20 19:50:21 1.15 @@ -1048,15 +1048,29 @@ ;;; ;;; Help -(defgeneric help-stream (frame title)) - -(defmethod help-stream (frame title) - (open-window-stream - :label title - :input-buffer (#+(or mcclim building-mcclim) climi::frame-event-queue - #-(or mcclim building-mcclim) silica:frame-input-buffer - *application-frame*) - :width 400)) +(defgeneric invoke-with-help-stream (esa title continuation) + (:documentation "Invoke `continuation' with a single argument - +a stream for writing on-line help for `esa' onto. The stream +should have the title, or name, `title' (a string), but the +specific meaning of this is left to the respective ESA.")) + +(defmethod invoke-with-help-stream (frame title continuation) + (funcall continuation + (open-window-stream + :label title + :input-buffer (#+(or mcclim building-mcclim) climi::frame-event-queue + #-(or mcclim building-mcclim) silica:frame-input-buffer + *application-frame*) + :width 400))) + +(defmacro with-help-stream ((stream title) &body body) + "Evaluate `body' with `stream' bound to a stream suitable for +writing help information on. `Title' must evaluate to a string, +and will be used for naming the resulting stream, if that makes +sense for the ESA." + `(invoke-with-help-stream *esa-instance* ,title + #'(lambda (,stream) + ,@body))) (defun read-gestures-for-help (command-table) (with-input-focus (t) @@ -1389,12 +1403,12 @@ ((sort-by-keystrokes 'boolean :prompt "Sort by keystrokes?")) "Show which keys invoke which commands. Without a numeric prefix, sorts the list by command name. With a numeric prefix, sorts by key." - (let ((stream (help-stream *application-frame* (format nil "Help: Describe Bindings"))) - (command-table (find-applicable-command-table *application-frame*))) - (describe-bindings stream command-table - (if sort-by-keystrokes - #'sort-by-keystrokes - #'sort-by-name)))) + (let ((command-table (find-applicable-command-table *application-frame*))) + (with-help-stream (stream (format nil "Help: Describe Bindings")) + (describe-bindings stream command-table + (if sort-by-keystrokes + #'sort-by-keystrokes + #'sort-by-name))))) (set-key `(com-describe-bindings ,*numeric-argument-marker*) 'help-table '((#\h :control) (#\b))) @@ -1412,12 +1426,10 @@ (let ((gesture-name (format nil "~{~A~#[~; ~; ~]~}" (mapcar #'gesture-name gestures)))) (if command - (let ((out-stream - (help-stream *application-frame* - (format nil "~10THelp: Describe Key for ~A" gesture-name)))) + (with-help-stream (out-stream (format nil "~10THelp: Describe Key for ~A" gesture-name)) (describe-command-binding-to-stream gesture-name command - :command-table command-table - :stream out-stream)) + :command-table command-table + :stream out-stream)) (display-message "Unbound gesture: ~A" gesture-name)))))) (set-key 'com-describe-key @@ -1427,15 +1439,14 @@ (define-command (com-describe-command :name t :command-table help-table) ((command 'command-name :prompt "Describe command")) "Display documentation for the given command." - (let* ((command-table (find-applicable-command-table *application-frame*)) - (out-stream (help-stream *application-frame* - (format nil "~10THelp: Describe Command for ~A" + (let ((command-table (find-applicable-command-table *application-frame*))) + (with-help-stream (out-stream (format nil "~10THelp: Describe Command for ~A" (command-line-name-for-command command command-table - :errorp nil))))) - (describe-command-to-stream command - :command-table command-table - :stream out-stream))) + :errorp nil))) + (describe-command-to-stream command + :command-table command-table + :stream out-stream)))) (set-key `(com-describe-command ,*unsupplied-argument-marker*) 'help-table @@ -1480,30 +1491,28 @@ collect (cons function keys)))) (if (null results) (display-message "No results for ~{~A~^, ~}" words) - (let ((out-stream (help-stream *application-frame* - (format nil "~10THelp: Apropos ~{~A~^, ~}" - words)))) - (loop for (command . keys) in results - for documentation = (or (documentation command 'function) - "Not documented.") - do (with-text-style (out-stream '(:sans-serif :bold nil)) - (present command - `(command-name :command-table ,command-table) - :stream out-stream)) - (with-drawing-options (out-stream :ink +dark-blue+ - :text-style '(:fix nil nil)) - (format out-stream "~30T~:[M-x ... RETURN~;~:*~{~A~^, ~}~]" - (mapcar (lambda (keystrokes) - (format nil "~{~A~^ ~}" - (mapcar #'gesture-name (reverse keystrokes)))) - (car keys)))) - (with-text-style (out-stream '(:sans-serif nil nil)) - (format out-stream "~&~2T~A~%" - (subseq documentation 0 (position #\Newline documentation)))) - count command into length - finally (change-space-requirements out-stream - :height (* length (stream-line-height out-stream))) - (scroll-extent out-stream 0 0))))))) + (with-help-stream (out-stream (format nil "~10THelp: Apropos ~{~A~^, ~}" words)) + (loop for (command . keys) in results + for documentation = (or (documentation command 'function) + "Not documented.") + do (with-text-style (out-stream '(:sans-serif :bold nil)) + (present command + `(command-name :command-table ,command-table) + :stream out-stream)) + (with-drawing-options (out-stream :ink +dark-blue+ + :text-style '(:fix nil nil)) + (format out-stream "~30T~:[M-x ... RETURN~;~:*~{~A~^, ~}~]" + (mapcar (lambda (keystrokes) + (format nil "~{~A~^ ~}" + (mapcar #'gesture-name (reverse keystrokes)))) + (car keys)))) + (with-text-style (out-stream '(:sans-serif nil nil)) + (format out-stream "~&~2T~A~%" + (subseq documentation 0 (position #\Newline documentation)))) + count command into length + finally (change-space-requirements out-stream + :height (* length (stream-line-height out-stream))) + (scroll-extent out-stream 0 0))))))) (set-key `(com-apropos-command ,*unsupplied-argument-marker*) 'help-table --- /project/mcclim/cvsroot/mcclim/ESA/packages.lisp 2008/01/13 22:22:06 1.12 +++ /project/mcclim/cvsroot/mcclim/ESA/packages.lisp 2008/01/20 19:50:21 1.13 @@ -82,7 +82,7 @@ #:convert-to-gesture #:gesture-name #:global-esa-table #:keyboard-macro-table #:help-table - #:help-stream + #:invoke-with-help-stream #:with-help-stream #:set-key #:find-applicable-command-table #:esa-command-parser

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 20 Jan '08

20 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv12206/Drei Modified Files: core-commands.lisp drei-redisplay.lisp packages.lisp views.lisp Log Message: Improved support for nonbuffer views, including various bugfixes here and there, used that support to revamp Climacs' typeout panes, which in turn required some ESA changes. Stability not guaranteed, please test. --- /project/mcclim/cvsroot/mcclim/Drei/core-commands.lisp 2008/01/17 11:29:55 1.13 +++ /project/mcclim/cvsroot/mcclim/Drei/core-commands.lisp 2008/01/20 19:50:20 1.14 @@ -296,7 +296,7 @@ '((:home :control))) (define-command (com-page-down :name t :command-table movement-table) () - (page-down (current-view))) + (page-down (editor-pane (drei-instance)) (current-view))) (set-key 'com-page-down 'movement-table @@ -307,7 +307,7 @@ '((:next))) (define-command (com-page-up :name t :command-table movement-table) () - (page-up (current-view))) + (page-up (editor-pane (drei-instance)) (current-view))) (set-key 'com-page-up 'movement-table --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/19 12:39:28 1.45 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/20 19:50:20 1.46 @@ -652,7 +652,7 @@ (maybe-clear last-clear-x (x1 stroke-dimensions)) (setf last-clear-x (x2 stroke-dimensions))) ;; This clears from end of line to the end of the sheet. - finally (maybe-clear (1+ last-clear-x) (bounding-rectangle-width pane)))) + finally (maybe-clear last-clear-x (bounding-rectangle-width pane)))) ;; Now actually draw them in a way that makes sure they all ;; touch the bottom of the line. (loop for stroke-index below (line-stroke-count line) @@ -994,8 +994,9 @@ (with-bounding-rectangle* (old-x1 old-y1 old-x2 old-y2) drei (replay drei stream) (with-bounding-rectangle* (new-x1 new-y1 new-x2 new-y2) drei - (unless (and (= new-x1 old-x1) (= new-y1 old-y2) - (= new-x2 old-x2) (= new-y2 old-y2)) + (unless (or (and (= new-x1 old-x1) (= new-y1 old-y2) + (= new-x2 old-x2) (= new-y2 old-y2)) + (null (output-record-parent drei))) (recompute-extent-for-changed-child (output-record-parent drei) drei old-x1 old-y1 old-x2 old-y2)))) (when (point-cursor drei) @@ -1018,6 +1019,22 @@ ;;; ;;; Drei pane redisplay. +(defgeneric handle-redisplay (pane view region) + (:documentation "Handle redisplay of `view' upon `pane' (which +is a Drei pane) in the given region. Methods defined on this +function should mark their redisplay information as dirty based +on `region' and call the default method, which will in turn call +`display-drei' on `pane'.") + (:method ((pane drei-pane) (view drei-view) (region region)) + (display-drei pane))) + +(defmethod handle-repaint ((pane drei-pane) region) + (handle-redisplay pane (view pane) region)) + +(defmethod handle-redisplay ((pane drei-pane) (view drei-buffer-view) (region region)) + (invalidate-all-strokes (view pane) :cleared t) + (call-next-method)) + (defun reposition-pane (drei-pane) "Try to put point close to the middle of the pane by moving top half a pane-size up." @@ -1037,14 +1054,15 @@ "Reposition the pane if point is outside the region delimited by the top/bot marks of its view. Returns true if adjustment was needed." - (with-accessors ((buffer buffer) (top top) (bot bot) - (point point)) (view drei-pane) - (when (or (mark< point top) - (mark> point bot)) - (reposition-pane drei-pane) - t))) + (when (typep (view drei-pane) 'point-mark-view) + (with-accessors ((buffer buffer) (top top) (bot bot) + (point point)) (view drei-pane) + (when (or (mark< point top) + (mark> point bot)) + (reposition-pane drei-pane) + t)))) -(defun page-down (view) +(defmethod page-down (pane (view drei-buffer-view)) (with-accessors ((top top) (bot bot)) view (when (mark> (size (buffer bot)) bot) (setf (offset top) (offset bot)) @@ -1052,7 +1070,7 @@ (setf (offset (point view)) (offset top)) (invalidate-all-strokes view)))) -(defun page-up (view) +(defmethod page-up (pane (view drei-buffer-view)) (with-accessors ((top top) (bot bot)) view (when (> (offset top) 0) (setf (offset (point view)) (offset top)) @@ -1096,11 +1114,6 @@ ;; We start all over! (display-drei-pane (pane-frame pane) pane))))))) -(defmethod handle-repaint ((pane drei-pane) region) - (declare (ignore region)) - (invalidate-all-strokes (view pane) :cleared t) - (redisplay-frame-pane (pane-frame pane) pane)) - (defmethod pane-needs-redisplay :around ((pane drei-pane)) (values (call-next-method) nil)) --- /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2008/01/19 12:39:28 1.43 +++ /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2008/01/20 19:50:20 1.44 @@ -216,7 +216,7 @@ ;; Views and their facilities. #:drei-view #:modified-p #:no-cursors - #:drei-buffer-view #:buffer #:top #:bot + #:drei-buffer-view #:buffer #:top #:bot #:buffer-view-p #:drei-syntax-view #:syntax #:pump-state-for-offset-with-syntax #:stroke-pump-with-syntax @@ -248,12 +248,14 @@ #:minibuffer - #:drei #:drei-pane #:drei-gadget-pane #:drei-area + #:drei #:editor-pane + #:drei-pane #:drei-gadget-pane #:drei-area #:handling-drei-conditions #:handle-drei-condition #:execute-drei-command ;; Redisplay engine. #:display-drei-view-contents #:display-drei-view-cursor + #:handle-redisplay #:face #:make-face #:face-ink #:face-style #:drawing-options #:make-drawing-options #:drawing-options-face #:drawing-options-function --- /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/18 11:00:23 1.23 +++ /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/20 19:50:20 1.24 @@ -504,6 +504,14 @@ when (and slot-initarg slot-boundp) nconc (list slot-initarg (slot-value view slot-name))))))) +(defgeneric page-down (pane view) + (:documentation "Scroll `view', which is displayed on `pane', a +page up.")) + +(defgeneric page-up (pane view) + (:documentation "Scroll `view', which is displayed on `pane', a +page up.")) + (defclass drei-buffer-view (drei-view) ((%buffer :accessor buffer :initform (make-instance 'drei-buffer) @@ -574,6 +582,10 @@ (setf (fill-pointer string) 0) string)) +(defun buffer-view-p (view) + "Return true if `view' is a `drei-buffer-view'." + (typep view 'drei-buffer-view)) + (defclass drei-syntax-view (drei-buffer-view) ((%syntax :accessor syntax :documentation "An instance of the syntax class used

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 20 Jan '08

20 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv11650/Drei Modified Files: lisp-syntax.lisp Log Message: Don't try to extract package from invalid in-package forms. --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/19 20:06:01 1.69 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/20 19:45:24 1.70 @@ -1254,7 +1254,8 @@ (and (form-token-p candidate) (eq (form-to-object syntax candidate :no-error t) - 'cl:in-package))))) + 'cl:in-package) + (second-form (children x)))))) (extract (x) (let ((designator (second-form (children x)))) (form-to-object syntax designator

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 19 Jan '08

19 Jan '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv2101 Modified Files: decls.lisp Log Message: Minor docstring fix. --- /project/mcclim/cvsroot/mcclim/decls.lisp 2008/01/19 09:38:20 1.48 +++ /project/mcclim/cvsroot/mcclim/decls.lisp 2008/01/19 20:35:47 1.49 @@ -643,7 +643,7 @@ (:documentation "If gesture is an input editing command, stream-process-gesture performs the input editing operation on the input editing stream `stream' and returns NIL. Otherwise, it -returns the two values gesture and type.")) +returns the two values `gesture' and `type'.")) ;;; 24.4 Reading and Writing of Tokens

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 19 Jan '08

19 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv30054/Drei Modified Files: lisp-syntax.lisp Log Message: Improved Forward Expression and fixed minor bug in Drei test suite. --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/15 15:53:53 1.68 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/19 20:06:01 1.69 @@ -2034,13 +2034,17 @@ (update-parse syntax 0 (offset mark)) (let ((potential-form (or (form-after syntax (offset mark)) (form-around syntax (offset mark))))) - (when (and (not (null potential-form)) - (not (= (offset mark) (end-offset potential-form)))) - (typecase potential-form - (reader-conditional-form - (setf (offset mark) (or (start-offset (first-form (children potential-form))) - (end-offset potential-form)))) - (t (setf (offset mark) (end-offset potential-form))))))) + (when (not (null potential-form)) + (when (and (not (form-at-top-level-p potential-form)) + (= (offset mark) (end-offset potential-form))) + (setf potential-form (parent potential-form))) + (when (and (not (null potential-form)) + (not (= (offset mark) (end-offset potential-form)))) + (typecase potential-form + (reader-conditional-form + (setf (offset mark) (or (start-offset (first-form (children potential-form))) + (end-offset potential-form)))) + (t (setf (offset mark) (end-offset potential-form)))))))) (defmethod forward-delete-expression (mark (syntax lisp-syntax) &optional (count 1) (limit-action #'error-limit-action))

1 0

[mcclim-cvs] CVS mcclim/Drei/Tests
by thenriksen 19 Jan '08

19 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei/Tests In directory clnet:/tmp/cvs-serv30054/Drei/Tests Modified Files: core-tests.lisp lisp-syntax-tests.lisp Log Message: Improved Forward Expression and fixed minor bug in Drei test suite. --- /project/mcclim/cvsroot/mcclim/Drei/Tests/core-tests.lisp 2007/12/08 08:53:49 1.6 +++ /project/mcclim/cvsroot/mcclim/Drei/Tests/core-tests.lisp 2008/01/19 20:06:01 1.7 @@ -453,6 +453,6 @@ (backward-object mark2) (dolist (low (list 2 mark1)) (dolist (high (list (- (size (current-buffer)) 2) mark2)) - (with-narrowed-buffer (*drei-instance* low high t) + (with-narrowed-buffer ((drei-instance) low high t) (is (= (offset (point)) 2)) (is (= (offset (mark)) (- (size (current-buffer)) 2))))))))) --- /project/mcclim/cvsroot/mcclim/Drei/Tests/lisp-syntax-tests.lisp 2008/01/13 17:10:24 1.14 +++ /project/mcclim/cvsroot/mcclim/Drei/Tests/lisp-syntax-tests.lisp 2008/01/19 20:06:01 1.15 @@ -828,7 +828,9 @@ (nil nil (5 18 2) "#+nil (list 1 2 3)") (nil nil (0 2 nil) - "#+nil (list 1 2 3)")) + "#+nil (list 1 2 3)") + (nil nil (6 7 3) + " (nil) ")) (motion-fun-one-test (list lisp-syntax) (64 4 (22 41 11)

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 19 Jan '08

19 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv28952/Drei Modified Files: drei-redisplay.lisp packages.lisp Log Message: Added facility for highlighting strokes. Useful for debugging, as well as idle curiosity. --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/17 23:11:06 1.44 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/19 12:39:28 1.45 @@ -549,20 +549,35 @@ (funcall (drawing-options-function (stroke-drawing-options stroke)) stream view stroke cursor-x cursor-y #'stroke-drawing-fn nil))) +(defvar *highlight-strokes* nil + "If true, draw a box around all strokes and a line through +their baseline..") + +(defvar *stroke-boundary-ink* +red+ + "The ink with which stroke boundaries will be highlighted when +`*highlight-strokes* is true.") + +(defvar *stroke-baseline-ink* +blue+ + "The ink with which stroke baselines will be highlighted when +`*highlight-strokes* is true.") + (defun draw-stroke (pane view stroke cursor-x cursor-y) "Draw `stroke' on `pane' with a baseline at `cursor-y'. Drawing starts at the horizontal offset `cursor-x'. Stroke must thus have updated dimensional information. Nothing will be done unless `stroke' is dirty." (when (stroke-dirty stroke) - (when (> (x2 (stroke-dimensions stroke)) - (bounding-rectangle-width pane)) - (change-space-requirements pane :width (x2 (stroke-dimensions stroke)))) - (when (> (y2 (stroke-dimensions stroke)) - (bounding-rectangle-height pane)) - (change-space-requirements pane :height (y2 (stroke-dimensions stroke)))) - (funcall (drawing-options-function (stroke-drawing-options stroke)) - pane view stroke cursor-x cursor-y #'stroke-drawing-fn t))) + (with-accessors ((x1 x1) (y1 y1) (x2 x2) (y2 y2) + (center center)) (stroke-dimensions stroke) + (when (> x2 (bounding-rectangle-width pane)) + (change-space-requirements pane :width x2)) + (when (> y2 (bounding-rectangle-height pane)) + (change-space-requirements pane :height y2)) + (funcall (drawing-options-function (stroke-drawing-options stroke)) + pane view stroke cursor-x cursor-y #'stroke-drawing-fn t) + (when *highlight-strokes* + (draw-rectangle* pane x1 y1 x2 (1- y2) :filled nil :ink *stroke-boundary-ink*) + (draw-line* pane x1 (+ y1 center) x2 (+ y1 center) :ink *stroke-baseline-ink*))))) (defun end-line (line x1 y1 line-width line-height) "End the addition of strokes to `line' for now, and update the @@ -637,7 +652,7 @@ (maybe-clear last-clear-x (x1 stroke-dimensions)) (setf last-clear-x (x2 stroke-dimensions))) ;; This clears from end of line to the end of the sheet. - finally (maybe-clear last-clear-x (bounding-rectangle-width pane)))) + finally (maybe-clear (1+ last-clear-x) (bounding-rectangle-width pane)))) ;; Now actually draw them in a way that makes sure they all ;; touch the bottom of the line. (loop for stroke-index below (line-stroke-count line) --- /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2008/01/17 11:29:55 1.42 +++ /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2008/01/19 12:39:28 1.43 @@ -276,6 +276,10 @@ #:*comment-drawing-options* #:*error-drawing-options* + #:*highlight-strokes* + #:*stroke-boundary-ink* + #:*stroke-baseline-ink* + ;; DREI program interface stuff. #:with-drei-options #:performing-drei-operations #:invoke-performing-drei-operations

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 19 Jan '08

19 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv3342/Drei Modified Files: drei.lisp Log Message: Updated Drei documentation. --- /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2008/01/17 11:29:55 1.28 +++ /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2008/01/19 10:24:19 1.29 @@ -70,8 +70,8 @@ return `object'.")) (defun drei-instance (&optional (object *esa-instance*)) - "Return the currently running Drei instance. This function -calls `drei-instance-of' on its argument." + "Return the Drei instance of `object'. If `object' is not +provided, the currently running Drei instance will be returned." (drei-instance-of object)) (defun (setf drei-instance) (new-instance &optional (object *esa-instance*))

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

mcclim-cvs