mcclim-cvs January 2008

mcclim-cvs@common-lisp.net

7 participants
255 discussions

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

30 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv9307/Drei Modified Files: input-editor.lisp Log Message: Fixed WITH-INPUT-EDITOR-TYPEOUT for Drei. --- /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/01/30 21:21:43 1.28 +++ /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/01/30 21:30:02 1.29 @@ -760,9 +760,9 @@ (defmethod invoke-with-input-editor-typeout ((stream drei-input-editing-mixin) (continuation function) &key erase) (declare (ignore erase)) - (let ((drei (drei-instance stream))) - (when (minibuffer drei) - (funcall continuation (minibuffer drei))))) + (with-bound-drei-special-variables ((drei-instance stream)) + (with-minibuffer-stream (minibuffer) + (funcall continuation minibuffer)))) (defmacro with-input-editor-typeout ((&optional (stream t) &rest args &key erase)

1 0

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

30 Jan '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv8469 Modified Files: input-editing-drei.lisp input-editing.lisp panes.lisp Log Message: WITH-INPUT-EDITING now works really well with Drei. --- /project/mcclim/cvsroot/mcclim/input-editing-drei.lisp 2008/01/30 17:08:01 1.8 +++ /project/mcclim/cvsroot/mcclim/input-editing-drei.lisp 2008/01/30 21:21:43 1.9 @@ -154,18 +154,23 @@ initial-contents class) (let ((editing-stream (make-instance class - :stream stream - :initial-contents initial-contents))) + :stream stream))) + (if (stringp initial-contents) + (replace-input editing-stream initial-contents) + (presentation-replace-input editing-stream + (first initial-contents) + (second initial-contents) + (stream-default-view editing-stream))) (unwind-protect (loop - (block rescan - (handler-bind ((rescan-condition - #'(lambda (c) - (declare (ignore c)) - (reset-scan-pointer editing-stream) - (return-from rescan nil)))) - (return-from invoke-with-input-editing - (funcall continuation editing-stream))))) + (block rescan + (handler-bind ((rescan-condition + #'(lambda (c) + (declare (ignore c)) + (reset-scan-pointer editing-stream) + (return-from rescan nil)))) + (return-from invoke-with-input-editing + (funcall continuation editing-stream))))) (finalize editing-stream input-sensitizer)))) (defmethod immediate-rescan ((stream standard-input-editing-stream)) --- /project/mcclim/cvsroot/mcclim/input-editing.lisp 2008/01/30 15:58:14 1.58 +++ /project/mcclim/cvsroot/mcclim/input-editing.lisp 2008/01/30 21:21:44 1.59 @@ -55,9 +55,7 @@ (fmakunbound 'interactive-stream-p)) (defgeneric interactive-stream-p (stream) (:method (stream) - (cl:interactive-stream-p stream)) - (:method ((stream clim-stream-pane)) - t))) + (cl:interactive-stream-p stream)))) ;;; These helper functions take the arguments of ACCEPT so that they ;;; can be used directly by ACCEPT. --- /project/mcclim/cvsroot/mcclim/panes.lisp 2008/01/30 11:48:40 1.188 +++ /project/mcclim/cvsroot/mcclim/panes.lisp 2008/01/30 21:21:44 1.189 @@ -27,7 +27,7 @@ ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. -;;; $Id: panes.lisp,v 1.188 2008/01/30 11:48:40 thenriksen Exp $ +;;; $Id: panes.lisp,v 1.189 2008/01/30 21:21:44 thenriksen Exp $ (in-package :clim-internals) @@ -2528,6 +2528,9 @@ "This class implements a pane that supports the CLIM graphics, extended input and output, and output recording protocols.")) +(defmethod interactive-stream-p ((stream clim-stream-pane)) + t) + (defun invoke-display-function (frame pane) (let ((display-function (pane-display-function pane))) (cond ((consp display-function)

1 0

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

30 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv8469/Drei Modified Files: drei.lisp input-editor.lisp views.lisp Log Message: WITH-INPUT-EDITING now works really well with Drei. --- /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2008/01/30 11:48:40 1.35 +++ /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2008/01/30 21:21:43 1.36 @@ -234,8 +234,7 @@ ;;; The basic Drei class. (defclass drei () - ((%view :initform (make-instance 'textual-drei-syntax-view) - :initarg :view + ((%view :initarg :view :accessor view :documentation "The CLIM view that will be used whenever this Drei is being displayed. During redisplay, the @@ -345,16 +344,18 @@ (cursors drei)))) (defmethod initialize-instance :after ((drei drei) &rest args &key - active single-line (editable-p t) - no-cursors) + view active single-line (editable-p t) + no-cursors initial-contents) (declare (ignore args)) - (with-accessors ((buffer buffer) - (point point) (mark mark)) (view drei) - (setf (active (view drei)) active) - (setf (single-line-p (implementation buffer)) single-line) - (setf (read-only-p buffer) (not editable-p)) - (setf (no-cursors (view drei)) no-cursors) - (add-view-cursors drei))) + (unless view ; Unless a view object has been provided... + ;; Create it with the provided initargs. + (setf (view drei) (make-instance 'textual-drei-syntax-view + :active active + :single-line single-line + :read-only (not editable-p) + :no-cursors no-cursors + :initial-contents initial-contents))) + (add-view-cursors drei)) (defmethod (setf view) :after (new-val (drei drei)) ;; Delete the old cursors, then add the new ones, provided the --- /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/01/30 15:57:35 1.27 +++ /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/01/30 21:21:43 1.28 @@ -53,7 +53,7 @@ (defmethod initialize-instance :after ((obj drei-input-editing-mixin) &rest args - &key stream (initial-contents "") + &key stream (cursor-visibility t) (min-width 0)) (check-type min-width (or (integer 0) (eql t))) @@ -66,9 +66,6 @@ (apply #'make-instance 'drei-area :editor-pane stream - :buffer (make-instance 'drei-buffer - :name "Input-editor buffer" - :initial-contents initial-contents) :x-position cx :y-position cy :active cursor-visibility @@ -76,8 +73,10 @@ :allow-other-keys t args))) ;; XXX Really add it here? - (stream-add-output-record stream (drei-instance obj)) - (display-drei (drei-instance obj))))) + (stream-add-output-record stream (drei-instance obj))))) + +(defmethod stream-default-view ((stream drei-input-editing-mixin)) + (view (drei-instance stream))) (defmethod stream-insertion-pointer ((stream drei-input-editing-mixin)) @@ -155,17 +154,23 @@ ;; we can support fancy accept methods such as the one for ;; `command-or-form' (unless (stream-rescanning-p stream) - (call-next-method) + ;; Put the prompt in the proper place, but be super careful not to + ;; mess with the insertion pointer. + (let ((ip-clone (clone-mark (point (view (drei-instance stream)))))) + (unwind-protect (progn (setf (stream-insertion-pointer stream) + (stream-scan-pointer stream)) + (call-next-method)) + (setf (stream-insertion-pointer stream) (offset ip-clone))) + (redraw-input-buffer stream)) ;; We skip ahead of any noise strings to put us past the ;; prompt. This is safe, because the noise strings are to be ;; ignored anyway, but we need to be ahead to set the input ;; position properly (ie. after the prompt). - (loop - with buffer = (buffer (view (drei-instance stream))) - until (>= (stream-scan-pointer stream) (size buffer)) - while (or (typep #1=(buffer-object buffer (stream-scan-pointer stream)) 'noise-string) - (delimiter-gesture-p #1#)) - do (incf (stream-scan-pointer stream))) + (loop with buffer = (buffer (view (drei-instance stream))) + until (>= (stream-scan-pointer stream) (size buffer)) + while (or (typep #1=(buffer-object buffer (stream-scan-pointer stream)) 'noise-string) + (delimiter-gesture-p #1#)) + do (incf (stream-scan-pointer stream))) (setf (input-position stream) (stream-scan-pointer stream)))) (defmethod stream-accept :after ((stream drei-input-editing-mixin) type &key &allow-other-keys) @@ -670,6 +675,9 @@ (defmethod input-editor-format ((stream drei-input-editing-mixin) format-string &rest format-args) + "Insert a noise string at the insertion-pointer of `stream'." + ;; Since everything inserted with this method is noise strings, we + ;; do not bother to modify the scan pointer or queue rescans. (let* ((drei (drei-instance stream)) (output (apply #'format nil format-string format-args))) (when (or (stream-rescanning-p stream) @@ -679,14 +687,12 @@ ;; malfunction. Of course, the newlines inserted this way aren't ;; actually noise-strings. FIXME. (loop for (seq . rest) on (split-sequence #\Newline output) - when (plusp (length seq)) - do (insert-object (point (view drei)) (make-instance 'noise-string - :string seq)) - unless (null rest) - do (insert-object (point (view drei)) #\Newline)) - ;; Since everything inserted with this method is noise strings, we - ;; do not bother to modify the scan pointer or queue rescans. - (display-drei drei))) + when (plusp (length seq)) + do (insert-object (point (view drei)) + (make-instance 'noise-string + :string seq)) + unless (null rest) + do (insert-object (point (view drei)) #\Newline)))) (defmethod redraw-input-buffer ((stream drei-input-editing-mixin) &optional (start-position 0)) --- /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/30 07:31:34 1.31 +++ /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/30 21:21:43 1.32 @@ -287,7 +287,9 @@ ;;; Readonly (defclass read-only-mixin () - ((read-only-p :initform nil :accessor read-only-p))) + ((read-only-p :initform nil + :accessor read-only-p + :initarg :read-only))) (define-condition buffer-read-only (user-condition-mixin simple-error) ((buffer :reader condition-buffer :initarg :buffer)) @@ -376,13 +378,17 @@ (:default-initargs :implementation (make-instance 'extended-standard-buffer))) (defmethod initialize-instance :after ((buffer drei-buffer) &rest args - &key initial-contents) + &key read-only single-line + initial-contents) (declare (ignore args)) - (with-accessors ((point point)) buffer + (with-accessors ((point point) + (implementation implementation)) buffer (when initial-contents (check-type initial-contents array) (insert-buffer-sequence buffer 0 initial-contents)) - (setf point (make-buffer-mark buffer 0 :right)) + (setf point (make-buffer-mark buffer (size buffer) :right)) + (setf (read-only-p implementation) read-only + (single-line-p implementation) single-line) ;; Hack: we need to be told whenever the undo facilities in the ;; implementation buffer changes the buffer contents. (add-observer (implementation buffer) buffer))) @@ -520,7 +526,6 @@ (defclass drei-buffer-view (drei-view) ((%buffer :accessor buffer - :initform (make-instance 'drei-buffer) :initarg :buffer :type drei-buffer :accessor buffer @@ -571,11 +576,20 @@ with top and bot marks delimiting the visible region. These marks are automatically set if applicable.")) -(defmethod initialize-instance :after ((view drei-buffer-view) &rest initargs) +(defmethod initialize-instance :after ((view drei-buffer-view) &rest initargs + &key buffer single-line read-only + initial-contents) (declare (ignore initargs)) - (with-accessors ((top top) (bot bot) (buffer buffer)) view - (setf top (make-buffer-mark buffer 0 :left) - bot (make-buffer-mark buffer (size buffer) :right)))) + (with-accessors ((top top) (bot bot)) view + (unless buffer + ;; So many fun things are defined on (setf buffer) that we use + ;; slot-value here. This is just a glorified initform anyway. + (setf (slot-value view '%buffer) (make-instance 'drei-buffer + :single-line single-line + :read-only read-only + :initial-contents initial-contents))) + (setf top (make-buffer-mark (buffer view) 0 :left) + bot (make-buffer-mark (buffer view) (size (buffer view)) :right)))) (defmethod (setf top) :after (new-value (view drei-buffer-view)) (invalidate-all-strokes view))

1 0

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

30 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv32120/Drei Modified Files: drei-redisplay.lisp Log Message: Fix *really* obscure case where changes to the Drei buffer would not be picked up by redisplay. --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/30 13:49:30 1.54 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/30 20:43:39 1.55 @@ -418,10 +418,10 @@ (invalidate-stroke stroke :modified t)) ;; Move to the next changed region, if it is not possible for ;; more stroks to overlap with the current one. - (when (and changed-region - (>= (stroke-end-offset stroke) - (cdr changed-region))) - (pop (changed-regions view))) + (loop while (and (first (changed-regions view)) + (>= (stroke-end-offset stroke) + (cdr (first (changed-regions view))))) + do (pop (changed-regions view))) (incf (line-stroke-count line)) (setf (line-end-offset line) (stroke-end-offset stroke)))))

1 0

[mcclim-cvs] CVS mcclim/Experimental/freetype
by dlichteblau 30 Jan '08

30 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Experimental/freetype In directory clnet:/tmp/cvs-serv18929 Modified Files: mcclim-freetype.asd Log Message: restored cffi freetype code --- /project/mcclim/cvsroot/mcclim/Experimental/freetype/mcclim-freetype.asd 2008/01/17 07:57:55 1.9 +++ /project/mcclim/cvsroot/mcclim/Experimental/freetype/mcclim-freetype.asd 2008/01/30 19:44:42 1.10 @@ -42,7 +42,46 @@ (:file "freetype-fonts-cffi"))) +#+sbcl (defmethod perform :after ((o load-op) (s (eql (asdf:find-system :mcclim-freetype)))) "Detect fonts using fc-match" (funcall (find-symbol (symbol-name '#:autoconfigure-fonts) :mcclim-freetype))) + +;;; Freetype autodetection +#-sbcl +(progn + (defun parse-fontconfig-output (s) + (let* ((match-string (concatenate 'string (string #\Tab) "file:")) + (matching-line + (loop for l = (read-line s nil nil) + while l + if (= (mismatch l match-string) (length match-string)) + do (return l))) + (filename (when matching-line + (probe-file + (subseq matching-line + (1+ (position #\" matching-line :from-end nil :test #'char=)) + (position #\" matching-line :from-end t :test #'char=)))))) + (when filename + (make-pathname :directory (pathname-directory filename))))) + + (defun warn-about-unset-font-path () + (warn "~%~%NOTE:~%~ +* Remember to set mcclim-freetype:*freetype-font-path* to the + location of the Bitstream Vera family of fonts on disk. If you + don't have them, get them from http://www.gnome.org/fonts/~%~%~%")) + + (defmethod perform :after ((o load-op) (s (eql (asdf:find-system :mcclim-freetype)))) + (unless + (setf (symbol-value (intern "*FREETYPE-FONT-PATH*" :mcclim-freetype)) + (find-bitstream-fonts)) + (warn-about-unset-font-path))) + + (defun find-bitstream-fonts () + (with-input-from-string + (s (with-output-to-string (asdf::*verbose-out*) + (let ((code (asdf:run-shell-command "fc-match -v Bitstream Vera"))) + (unless (zerop code) + (warn "~&fc-match failed with code ~D.~%" code))))) + (parse-fontconfig-output s))))

1 0

[mcclim-cvs] CVS mcclim/Backends/CLX
by dlichteblau 30 Jan '08

30 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Backends/CLX In directory clnet:/tmp/cvs-serv8153 Modified Files: medium.lisp Log Message: Fixed "Draw images from the upper-left corner in the CLX backend": Use a matching clipping region. Strange sense of deja-vu for me, too. --- /project/mcclim/cvsroot/mcclim/Backends/CLX/medium.lisp 2008/01/25 07:36:39 1.87 +++ /project/mcclim/cvsroot/mcclim/Backends/CLX/medium.lisp 2008/01/30 18:56:40 1.88 @@ -1211,7 +1211,7 @@ (xlib:with-gcontext (gcontext :clip-mask mask :clip-x x - :clip-y (- y height)) + :clip-y y) (xlib:copy-area pixmap gcontext 0 0 width height da x y))) (t

1 0

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

30 Jan '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv14733 Modified Files: input-editing-drei.lisp Log Message: Replay used input-editing streams whether they have an input-sensitizer or not. --- /project/mcclim/cvsroot/mcclim/input-editing-drei.lisp 2008/01/30 15:58:14 1.7 +++ /project/mcclim/cvsroot/mcclim/input-editing-drei.lisp 2008/01/30 17:08:01 1.8 @@ -109,14 +109,18 @@ (setf (cursor-visibility stream) nil) (let ((real-stream (encapsulating-stream-stream stream)) (record (drei:drei-instance stream))) - (when input-sensitizer - (erase-output-record record real-stream) - (funcall input-sensitizer - real-stream - #'(lambda () - (stream-add-output-record real-stream record) - (when (stream-drawing-p real-stream) - (replay record real-stream))))) + (cond (input-sensitizer + (erase-output-record record real-stream) + (funcall input-sensitizer + real-stream + #'(lambda () + (stream-add-output-record real-stream record) + (when (stream-drawing-p real-stream) + (replay record real-stream))))) + ;; We still want to replay it for the cursor visibility + ;; change... + ((stream-drawing-p real-stream) + (replay record real-stream) )) (setf (stream-cursor-position real-stream) (values 0 (nth-value 3 (input-editing-stream-bounding-rectangle stream))))))

1 0

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

30 Jan '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv27565 Modified Files: input-editing-drei.lisp input-editing-goatee.lisp input-editing.lisp Log Message: Made the input-editing streams and clim-stream-panes interactive streams. --- /project/mcclim/cvsroot/mcclim/input-editing-drei.lisp 2008/01/19 09:38:20 1.6 +++ /project/mcclim/cvsroot/mcclim/input-editing-drei.lisp 2008/01/30 15:58:14 1.7 @@ -25,15 +25,6 @@ (in-package :clim-internals) -(with-system-redefinition-allowed - (when (and (fboundp 'interactive-stream-p) - (not (typep (fdefinition 'interactive-stream-p) - 'generic-function))) - (fmakunbound 'interactive-stream-p)) - (defgeneric interactive-stream-p (stream) - (:method (stream) - (cl:interactive-stream-p stream)))) - (defclass empty-input-mixin () () (:documentation "A mixin class used for detecting empty input")) @@ -50,6 +41,9 @@ Members of this class are mutable.")) +(defmethod interactive-stream-p ((stream standard-input-editing-stream)) + t) + (defmethod stream-accept ((stream standard-input-editing-stream) type &rest args &key (view (stream-default-view stream)) --- /project/mcclim/cvsroot/mcclim/input-editing-goatee.lisp 2006/11/08 01:18:22 1.1 +++ /project/mcclim/cvsroot/mcclim/input-editing-goatee.lisp 2008/01/30 15:58:14 1.2 @@ -37,6 +37,9 @@ (rescanning-p :reader stream-rescanning-p :initform nil) (activation-gesture :accessor activation-gesture :initform nil))) +(defmethod interactive-stream-p ((stream goatee-input-editing-stream)) + t) + (defmethod stream-accept ((stream goatee-input-editing-stream) type &rest args &key (view (stream-default-view stream)) --- /project/mcclim/cvsroot/mcclim/input-editing.lisp 2008/01/19 09:38:20 1.57 +++ /project/mcclim/cvsroot/mcclim/input-editing.lisp 2008/01/30 15:58:14 1.58 @@ -48,6 +48,17 @@ `*delimiter-gestures*' is unspecified. `*delimiter-gestures*' and the elements in it may have dynamic extent.") +(with-system-redefinition-allowed + (when (and (fboundp 'interactive-stream-p) + (not (typep (fdefinition 'interactive-stream-p) + 'generic-function))) + (fmakunbound 'interactive-stream-p)) + (defgeneric interactive-stream-p (stream) + (:method (stream) + (cl:interactive-stream-p stream)) + (:method ((stream clim-stream-pane)) + t))) + ;;; These helper functions take the arguments of ACCEPT so that they ;;; can be used directly by ACCEPT.

1 0

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

30 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv27510/Drei Modified Files: input-editor.lisp Log Message: Removed strange double-call to (call-next-method). --- /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/01/30 11:48:40 1.26 +++ /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/01/30 15:57:35 1.27 @@ -786,8 +786,7 @@ :syntax "Lisp" :keep-syntax t) (redraw-input-buffer stream) - (call-next-method)) - (call-next-method)) + (call-next-method))) (define-presentation-method accept ((type expression) (stream drei-input-editing-mixin)

1 0

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

30 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv27422/Drei Modified Files: drei-clim.lisp Log Message: Clear the cursor whenever it is disabled. --- /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2008/01/30 11:48:40 1.36 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2008/01/30 15:56:42 1.37 @@ -100,12 +100,13 @@ (declare (ignore initargs)) (stream-add-output-record (output-stream object) object)) -(defmethod active ((cursor drei-cursor)) - "Whether the cursor is active or +(defgeneric active (cursor) + (:documentation "Whether the cursor is active or not. An active cursor is drawn using the active ink, and an inactive is drawn using the inactive ink. Typically, a cursor -will be active when the associated Drei view has focus." - (active (view cursor))) +will be active when the associated Drei view has focus.") + (:method ((cursor drei-cursor)) + (active (view cursor)))) (defgeneric ink (cursor) (:documentation "Return the ink object that should be used for @@ -116,6 +117,9 @@ (active-ink cursor) (inactive-ink cursor))) +(defmethod (setf enabled) :after ((new-val null) (cursor drei-cursor)) + (clear-output-record cursor)) + (defclass point-cursor (drei-cursor) () (:default-initargs @@ -141,7 +145,7 @@ (mark (view cursor))) (defmethod enabled ((cursor mark-cursor)) - *show-mark*) + (and (call-next-method) *show-mark*)) (defgeneric visible-1 (cursor view) (:documentation "Is `cursor', associated with `view', visible?

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 January 2008