December 2007 - mcclim-cvs@common-lisp.net

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 23 Dec '07

23 Dec '07

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv19783/Drei Modified Files: drei-clim.lisp Log Message: Gadget-value for Drei gadgets works again now. --- /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2007/12/10 21:25:12 1.24 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2007/12/23 00:40:36 1.25 @@ -223,8 +223,8 @@ ;; literal objects. We return a string if we can, an array ;; otherwise. This is a bit slow, as we cons up the array and then ;; probably a new one for the string, most of the time. - (let ((contents (buffer-sequence (buffer gadget) - 0 (size (buffer gadget))))) + (let ((contents (buffer-sequence (buffer (view gadget)) + 0 (size (buffer (view gadget)))))) (if (every #'characterp contents) (coerce contents 'string) contents)))

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 21 Dec '07

21 Dec '07

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv9368/Drei Modified Files: lisp-syntax.lisp Log Message: Fixed case of treatment of mark as offset in Lisp syntax. --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2007/12/21 23:10:49 1.39 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2007/12/21 23:38:20 1.40 @@ -1152,7 +1152,7 @@ form can be found, return the package specified in the attribute list. If no such package is specified, return \"CLIM-USER\"." (as-offsets ((offset mark-or-offset)) - (update-parse syntax 0 mark-or-offset) + (update-parse syntax 0 offset) (flet ((normalise (designator) (typecase designator (symbol

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 21 Dec '07

21 Dec '07

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv5211/Drei Modified Files: lisp-syntax.lisp packages.lisp Log Message: Added some more nifty utility functions to Lisp syntax. --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2007/12/20 10:33:36 1.38 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2007/12/21 23:10:49 1.39 @@ -1386,6 +1386,16 @@ `mark-or-offset' is returned." (form-toplevel syntax (expression-at-mark syntax mark-or-offset))) +(defun list-at-mark (syntax mark-or-offset) + "Return the list form that `mark-or-offset' is inside, or NIL +if no such form exists." + (as-offsets ((offset mark-or-offset)) + (let ((form-around (form-around syntax offset))) + (if (and (form-list-p form-around) + (> offset (start-offset form-around))) + form-around + (find-list-parent form-around))))) + (defun symbol-at-mark (syntax mark-or-offset &optional (form-fetcher 'expression-at-mark)) "Return a symbol token at `mark-or-offset'. This function will @@ -2002,16 +2012,23 @@ nil (form-around-in-children syntax (children stack-top) offset)))))) +(defun find-list-parent (form) + "Find a list parent of `form' and return it. If a list parent +cannot be found, return nil" + (let ((parent (parent form))) + (typecase parent + (list-form parent) + ((or form* null) nil) + (t (find-list-parent-offset parent))))) + (defun find-list-parent-offset (form fn) "Find a list parent of `form' and return `fn' applied to this parent token. `Fn' should be a function that returns an offset when applied to a token (eg. `start-offset' or `end-offset'). If a list parent cannot be found, return nil" - (let ((parent (parent form))) - (typecase parent - (list-form (funcall fn parent)) - ((or form* null) nil) - (t (find-list-parent-offset parent fn))))) + (let ((list-parent (find-list-parent form))) + (when list-parent + (funcall fn list-parent)))) (defun find-list-child-offset (form fn &optional (min-offset 0)) "Find a list child of `token' with a minimum start @@ -2032,6 +2049,7 @@ (funcall fn list-child))))) (defmethod backward-one-expression (mark (syntax lisp-syntax)) + (update-syntax syntax 0 0) (let ((potential-form (or (form-before syntax (offset mark)) (form-around syntax (offset mark))))) (when (and (not (null potential-form)) @@ -2039,6 +2057,7 @@ (setf (offset mark) (start-offset potential-form))))) (defmethod forward-one-expression (mark (syntax lisp-syntax)) + (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)) @@ -2050,6 +2069,7 @@ Return T if successful, or NIL if the buffer limit was reached.")) (defmethod forward-one-list (mark (syntax lisp-syntax)) + (update-parse syntax 0 (offset mark)) (loop for start = (offset mark) then (end-offset potential-form) for potential-form = (or (form-after syntax start) @@ -2067,6 +2087,7 @@ successful, or NIL if the buffer limit was reached.")) (defmethod backward-one-list (mark (syntax lisp-syntax)) + (update-parse syntax 0 (offset mark)) (loop for start = (offset mark) then (start-offset potential-form) for potential-form = (or (form-before syntax start) @@ -2082,6 +2103,7 @@ (drei-motion:define-motion-fns list) (defun down-list (mark syntax selector next-offset-fn target-offset-fn) + (update-parse syntax 0 (offset mark)) (labels ((find-offset (potential-form) (typecase potential-form (list-form (funcall target-offset-fn potential-form)) @@ -2094,14 +2116,17 @@ t)))) (defmethod forward-one-down ((mark mark) (syntax lisp-syntax)) + (update-parse syntax 0 (offset mark)) (when (down-list mark syntax #'form-after #'end-offset #'start-offset) (forward-object mark))) (defmethod backward-one-down ((mark mark) (syntax lisp-syntax)) + (update-parse syntax 0 (offset mark)) (when (down-list mark syntax #'form-before #'start-offset #'end-offset) (backward-object mark))) (defun up-list (mark syntax fn) + (update-parse syntax 0 (offset mark)) (let ((form (form-around syntax (offset mark)))) (when (if (and (form-list-p form) (/= (start-offset form) (offset mark)) @@ -2113,12 +2138,15 @@ t))) (defmethod backward-one-up (mark (syntax lisp-syntax)) + (update-parse syntax 0 (offset mark)) (up-list mark syntax #'start-offset)) (defmethod forward-one-up (mark (syntax lisp-syntax)) + (update-parse syntax 0 (offset mark)) (up-list mark syntax #'end-offset)) (defmethod backward-one-definition ((mark mark) (syntax lisp-syntax)) + (update-parse syntax 0 (offset mark)) (with-slots (stack-top) syntax ;; FIXME? This conses! I'm over it already. I don't think it ;; matters much, but if someone is bored, please profile it. @@ -2129,6 +2157,7 @@ and do (return t)))) (defmethod forward-one-definition ((mark mark) (syntax lisp-syntax)) + (update-parse syntax 0 (offset mark)) (with-slots (stack-top) syntax (loop for form in (children stack-top) when (and (formp form) @@ -2137,6 +2166,7 @@ and do (return t)))) (defmethod eval-defun ((mark mark) (syntax lisp-syntax)) + (update-parse syntax 0 (offset mark)) (with-slots (stack-top) syntax (loop for form in (children stack-top) when (and (mark<= (start-offset form) mark) --- /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2007/12/19 17:17:37 1.23 +++ /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2007/12/21 23:10:49 1.24 @@ -500,8 +500,10 @@ ;; Selecting forms based on mark #:form-around #:form-before #:form-after + #:find-list-parent #:expression-at-mark #:definition-at-mark + #:list-at-mark #:symbol-at-mark #:fully-quoted-form #:fully-unquoted-form

1 0

[mcclim-cvs] CVS mcclim/Experimental/freetype
by dlichteblau 21 Dec '07

21 Dec '07

Update of /project/mcclim/cvsroot/mcclim/Experimental/freetype In directory clnet:/tmp/cvs-serv8013 Modified Files: mcclim-freetype.asd Removed Files: mcclim-freetype-cffi.asd Log Message: Merged mcclim-freetype-cffi.asd into mcclim-freetype.asd. ... use the CFFI code for non-SBCL ... for now, keep the old alien code for SBCL --- /project/mcclim/cvsroot/mcclim/Experimental/freetype/mcclim-freetype.asd 2007/12/16 20:02:08 1.6 +++ /project/mcclim/cvsroot/mcclim/Experimental/freetype/mcclim-freetype.asd 2007/12/21 15:27:47 1.7 @@ -28,12 +28,17 @@ "lisp") (defsystem :mcclim-freetype - :depends-on (:clim-clx :mcclim) + :depends-on (:clim-clx :mcclim #-sbcl :cffi) :serial t :components + #+sbcl ((:file "freetype-package") (:uncompiled-cl-source-file "freetype-ffi") - (:file "freetype-fonts"))) + (:file "freetype-fonts")) + #-sbcl + ((:file "freetype-package-cffi") + (:uncompiled-cl-source-file "freetype-cffi") + (:file "freetype-fonts-cffi"))) ;;; Freetype autodetection @@ -75,4 +80,16 @@ #-sbcl (defmethod perform :after ((o load-op) (s (eql (asdf:find-system :mcclim-freetype)))) - (warn-about-unset-font-path)) + (unless + (setf (symbol-value (intern "*FREETYPE-FONT-PATH*" :mcclim-freetype)) + (find-bitstream-fonts)) + (warn-about-unset-font-path))) + +#-sbcl +(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
by dlichteblau 21 Dec '07

21 Dec '07

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv7470 Modified Files: mcclim.asd Log Message: Don't compile the pixie look if CLIM-BEAGLE is set. --- /project/mcclim/cvsroot/mcclim/mcclim.asd 2007/12/21 15:18:29 1.68 +++ /project/mcclim/cvsroot/mcclim/mcclim.asd 2007/12/21 15:21:28 1.69 @@ -543,7 +543,7 @@ ;; null backend :clim-null ) - :components (#-(or clim-gtkairo clim-graphic-forms) + :components (#-(or clim-gtkairo clim-graphic-forms clim-beagle) (:file "Looks/pixie" :pathname #.(make-pathname :directory '(:relative "Looks") :name "pixie" :type "lisp"))))

1 0

[mcclim-cvs] CVS mcclim
by dlichteblau 21 Dec '07

21 Dec '07

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv5363 Modified Files: mcclim.asd Log Message: Renamed the GTKAIRO feature to CLIM-GTKAIRO ... for consistency with CLIM-GRAPHIC-FORMS and CLIM-BEAGLE ... also CLIM-GL --- /project/mcclim/cvsroot/mcclim/mcclim.asd 2007/12/21 15:02:32 1.67 +++ /project/mcclim/cvsroot/mcclim/mcclim.asd 2007/12/21 15:18:29 1.68 @@ -62,7 +62,7 @@ (extensions:without-package-locks (load "gray-streams:gray-streams-library")) (load "gray-streams:gray-streams-library"))) - #-(or clx gtkairo clim-graphic-forms) + #-(or clx clim-gtkairo clim-graphic-forms) (require :clx) #+mp (when (eq mp::*initial-process* mp::*current-process*) (format t "~%~%You need to run (mp::startup-idle-and-top-level-loops) to start up the multiprocessing support.~%~%"))) @@ -530,20 +530,20 @@ ;; If we're on an implementation that ships CLX, use ;; it. Same if the user has loaded CLX already. #+(and (or sbcl scl openmcl ecl clx allegro) - (not (or gtkairo clim-graphic-forms clim-beagle))) + (not (or clim-gtkairo clim-graphic-forms clim-beagle))) :clim-clx #+clim-graphic-forms :clim-graphic-forms - #+gl :clim-opengl + #+clim-gl :clim-opengl ;; OpenMCL and MCL support the beagle backend (native ;; OS X look&feel on OS X). #+clim-beagle :clim-beagle - #+gtkairo :clim-gtkairo + #+clim-gtkairo :clim-gtkairo ;; null backend :clim-null ) - :components (#-(or gtkairo clim-graphic-forms) + :components (#-(or clim-gtkairo clim-graphic-forms) (:file "Looks/pixie" :pathname #.(make-pathname :directory '(:relative "Looks") :name "pixie" :type "lisp"))))

1 0

[mcclim-cvs] CVS mcclim
by dlichteblau 21 Dec '07

21 Dec '07

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv4004 Modified Files: mcclim.asd Log Message: Fixed McCLIM on OpenMCL/Linux. ... don't require cocoa by default. ... instead, conditionalize on CLIM-BEAGLE --- /project/mcclim/cvsroot/mcclim/mcclim.asd 2007/12/21 12:31:56 1.66 +++ /project/mcclim/cvsroot/mcclim/mcclim.asd 2007/12/21 15:02:32 1.67 @@ -83,7 +83,7 @@ :class requireable-system)) ;;; Required for the beagle backend (not activated by default) -#+clozure-common-lisp +#+clim-beagle (progn (require :cocoa) (require :objc-support)) @@ -530,16 +530,13 @@ ;; If we're on an implementation that ships CLX, use ;; it. Same if the user has loaded CLX already. #+(and (or sbcl scl openmcl ecl clx allegro) - (not (or gtkairo clim-graphic-forms))) + (not (or gtkairo clim-graphic-forms clim-beagle))) :clim-clx #+clim-graphic-forms :clim-graphic-forms #+gl :clim-opengl ;; OpenMCL and MCL support the beagle backend (native ;; OS X look&feel on OS X). - - ;; But until it's ready, it's no use forcing users to - ;; cope with possible bugs. - ;; #+(or openmcl mcl) :clim-beagle + #+clim-beagle :clim-beagle #+gtkairo :clim-gtkairo

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 21 Dec '07

21 Dec '07

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv28772/Drei Modified Files: basic-commands.lisp editing.lisp Log Message: Fixed some problems with editing functions not returning T when succesful, and editing commands not handling the proper errors. --- /project/mcclim/cvsroot/mcclim/Drei/basic-commands.lisp 2007/12/19 11:02:05 1.9 +++ /project/mcclim/cvsroot/mcclim/Drei/basic-commands.lisp 2007/12/21 14:22:07 1.10 @@ -310,14 +310,16 @@ ((count 'integer :prompt ,(concat "Number of " plural) :default 1)) ,(concat "Delete from point until the next " noun " end. With a positive numeric argument, delete that many " plural " forward.") - (,backward-delete (point) (current-syntax) count)) + (handling-motion-limit-errors (,plural) + (,backward-delete (point) (current-syntax) count))) ;; Backward Delete Unit (define-command (,com-backward-delete :name t :command-table ,command-table) ((count 'integer :prompt ,(concat "Number of " plural) :default 1)) ,(concat "Delete from point until the previous " noun " beginning. With a positive numeric argument, delete that many " plural " backward.") - (,backward-delete (point) (current-syntax) count))))))) + (handling-motion-limit-errors (,plural) + (,backward-delete (point) (current-syntax) count)))))))) (defmacro define-editing-commands (unit command-table &key noun --- /project/mcclim/cvsroot/mcclim/Drei/editing.lisp 2007/12/19 11:02:02 1.8 +++ /project/mcclim/cvsroot/mcclim/Drei/editing.lisp 2007/12/21 14:22:07 1.9 @@ -82,8 +82,9 @@ (mark syntax &optional (count 1) (limit-action #'error-limit-action)) (let ((mark2 (clone-mark mark))) - (,forward mark2 syntax count limit-action) - (delete-region mark mark2))) + (when (,forward mark2 syntax count limit-action) + (delete-region mark mark2) + t))) (defmethod ,forward-delete :around (mark syntax &optional (count 1) (limit-action #'error-limit-action)) @@ -100,8 +101,9 @@ (mark syntax &optional (count 1) (limit-action #'error-limit-action)) (let ((mark2 (clone-mark mark))) - (,backward mark2 syntax count limit-action) - (delete-region mark mark2))) + (when (,backward mark2 syntax count limit-action) + (delete-region mark mark2) + t))) (defmethod ,backward-delete :around (mark syntax &optional (count 1) (limit-action #'error-limit-action)) @@ -128,7 +130,8 @@ (region-to-sequence start mark))) (kill-ring-standard-push *kill-ring* (region-to-sequence start mark))) - (delete-region start mark)))) + (delete-region start mark) + t))) (defmethod ,forward-kill :around (mark syntax &optional (count 1) concatenate-p (limit-action #'error-limit-action)) @@ -156,7 +159,8 @@ (region-to-sequence start mark))) (kill-ring-standard-push *kill-ring* (region-to-sequence start mark))) - (delete-region start mark)))) + (delete-region start mark) + t))) (defmethod ,backward-kill :around (mark syntax &optional (count 1) concatenate-p (limit-action #'error-limit-action))

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 21 Dec '07

21 Dec '07

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv32321 Modified Files: mcclim.asd Log Message: Added nasty hack to inform CLISP users of their sub-par CLX, and offer a fix. --- /project/mcclim/cvsroot/mcclim/mcclim.asd 2007/12/20 08:07:16 1.65 +++ /project/mcclim/cvsroot/mcclim/mcclim.asd 2007/12/21 12:31:56 1.66 @@ -383,6 +383,19 @@ (:file "medium" :depends-on ("port" "keysyms" "package")) (:file "graft" :depends-on ("port" "package")) (:file "frame-manager" :depends-on ("medium" "port" "package")))))) +#+clisp +(defmethod asdf::traverse :around ((op compile-op) (c (eql (find-system :clim-clx)))) + ;; Just some random symbol I know is unexported in CLISP's CLX. + (if (eq (nth-value 1 (find-symbol "SET-SELECTION-OWNER" :xlib)) + :external) + (call-next-method) + (restart-case (error "Your CLX is not capable of running the McCLIM CLX backend") + (load-clx-via-asdf () + :report "Try replacing your CLX with a CLX loaded through ASDF, hopefully this will be Telent CLX." + (ext:without-package-lock ("XLIB") + (delete-package :xlib) + (asdf:oos 'asdf:load-op :clx)) + (call-next-method))))) (defsystem :clim-beagle :depends-on (clim)

1 0

[mcclim-cvs] CVS mcclim/Apps/Inspector
by thenriksen 20 Dec '07

20 Dec '07

Update of /project/mcclim/cvsroot/mcclim/Apps/Inspector In directory clnet:/tmp/cvs-serv7200/Apps/Inspector Modified Files: inspector.lisp Log Message: Oops, didn't mean to remove the Interactor pane from the Inspector with my last commit. --- /project/mcclim/cvsroot/mcclim/Apps/Inspector/inspector.lisp 2007/12/20 10:33:35 1.37 +++ /project/mcclim/cvsroot/mcclim/Apps/Inspector/inspector.lisp 2007/12/20 10:46:54 1.38 @@ -47,7 +47,7 @@ :display-function 'display-app) (int :interactor :width 600 :height 100 :max-height 100)) (:layouts - (default (vertically () (scrolling () app) #+nil int)))) + (default (vertically () (scrolling () app) int)))) (defmethod initialize-instance :after ((frame inspector) &rest args) (declare (ignore args))

1 0