mcclim-cvs

mcclim-cvs@common-lisp.net

1697 discussions

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 28 Mar '08

28 Mar '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv22830/Drei Modified Files: drei.lisp kill-ring.lisp Log Message: Drei kill rings are now global. --- /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2008/02/03 08:38:25 1.37 +++ /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2008/03/28 21:09:43 1.38 @@ -240,12 +240,6 @@ whenever this Drei is being displayed. During redisplay, the `stream-default-view' of the output stream will be temporarily bound to this value.") - (%kill-ring :initform (make-instance 'kill-ring :max-size 7) - :initarg :kill-ring - :accessor kill-ring - :type kill-ring - :documentation "The kill ring object associated -with the Drei instance.") (%previous-command :initform nil :accessor previous-command :documentation "The previous CLIM command @@ -507,12 +501,12 @@ proper values, taken from `drei-instance'. The keyword arguments can be used to provide forms that will be used to obtain values for the respective special variables, instead of finding their -value in `drei-instance'. This macro binds all of the usual Drei -special variables, but also some CLIM special variables needed -for ESA-style command parsing." +value in `drei-instance' or their existing binding. This macro +binds all of the usual Drei special variables, but also some CLIM +special variables needed for ESA-style command parsing." `(let* ((*esa-instance* ,drei-instance) (*kill-ring* ,(if kill-ring-p kill-ring - `(kill-ring (drei-instance)))) + '*kill-ring*)) (*minibuffer* ,(if minibuffer-p minibuffer `(find-available-minibuffer (drei-instance)))) (*command-parser* ,(if command-parser-p command-parser --- /project/mcclim/cvsroot/mcclim/Drei/kill-ring.lisp 2006/12/04 19:22:02 1.4 +++ /project/mcclim/cvsroot/mcclim/Drei/kill-ring.lisp 2008/03/28 21:09:43 1.5 @@ -187,6 +187,6 @@ (if reset (reset-yank-position kr)) (element> (kill-ring-cursor kr))) -(defparameter *kill-ring* nil +(defparameter *kill-ring* (make-instance 'kill-ring :max-size 7) "This special variable is bound to the kill ring of the running application or Drei instance whenever a command is executed.")

1 0

[mcclim-cvs] CVS mcclim
by rgoldman 28 Mar '08

28 Mar '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv8011 Modified Files: mcclim.asd Log Message: Updated the version requirement on the flexichain dependency. --- /project/mcclim/cvsroot/mcclim/mcclim.asd 2008/02/01 18:12:31 1.76 +++ /project/mcclim/cvsroot/mcclim/mcclim.asd 2008/03/28 19:53:19 1.77 @@ -119,7 +119,7 @@ (:file "package" :depends-on ("Lisp-Dep" "patch")))) (defsystem :clim-basic - :depends-on (:clim-lisp :spatial-trees :flexichain) + :depends-on (:clim-lisp :spatial-trees (:version "flexichain" "1.5.1")) :components ((:file "decls") (:file "protocol-classes" :depends-on ("decls")) (:module "Lisp-Dep" @@ -266,7 +266,7 @@ (defsystem :drei-mcclim - :depends-on (:flexichain :esa-mcclim :clim-core #+#.(mcclim.system::dep-on-swank) :swank) + :depends-on ((:version "flexichain" "1.5.1") :esa-mcclim :clim-core #+#.(mcclim.system::dep-on-swank) :swank) :components ((:module "cl-automaton" :pathname #.(make-pathname :directory '(:relative "Drei" "cl-automaton"))

1 0

[mcclim-cvs] CVS mcclim/Drei
by dlichteblau 07 Mar '08

07 Mar '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv29899 Modified Files: views.lisp Log Message: compilation fix --- /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/03/07 11:45:18 1.43 +++ /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/03/07 15:23:14 1.44 @@ -1078,7 +1078,7 @@ modification (for example, parenthesis matching). This function should return a list of pairs of buffer offsets, each pair delimiting a buffer region that should be redrawn.") - (:method ((view textual-drei-syntax-view view) (syntax syntax)) + (:method ((view textual-drei-syntax-view) (syntax syntax)) nil)) (defun invalidate-as-appropriate (view invalid-regions)

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 07 Mar '08

07 Mar '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv2493/Drei Modified Files: drei-redisplay.lisp Log Message: Create proper pump states for fundamental syntax, don't assume the offset is at the beginning of the line. --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/02/18 12:22:47 1.68 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/03/07 12:11:22 1.69 @@ -827,6 +827,12 @@ this pump state." line-index offset chunk-index) +(defun chunk-for-offset (buffer-line offset) + "Return the index of the first chunk of `buffer-line' that +contains `offset'." + (position (- offset (offset (start-mark buffer-line))) + (chunks buffer-line) :test #'<= :key #'car)) + (defun buffer-view-pump-state-for-offset (view offset) "Return a pump state usable for pumpting strokes for `view' (a `drei-buffer-view') from `offset'." @@ -844,7 +850,8 @@ (setf low-index (1+ middle))) ((mark< offset line-start) (setf high-index middle))) - finally (return (make-pump-state middle offset 0))))) + finally (return (make-pump-state + middle offset (chunk-for-offset this-line offset)))))) (defun fetch-chunk (line chunk-index) "Retrieve the `chunk-index'th chunk from `line'. The return

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 07 Mar '08

07 Mar '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv30336/Drei Modified Files: views.lisp Log Message: Update line data on Drei buffer-view creation. This fixes problem with modifying the buffer before initial synchronisation has been done. --- /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/02/17 14:54:47 1.42 +++ /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/03/07 11:45:18 1.43 @@ -634,7 +634,8 @@ bot (clone-mark top :right) lines-prefix 0 lines-suffix 0 - buffer-size (size (buffer view))))) + buffer-size (size (buffer view))) + (update-line-data view))) (defmethod (setf top) :after (new-value (view drei-buffer-view)) (invalidate-all-strokes view)) @@ -652,7 +653,8 @@ bot (clone-mark top :right) lines-prefix 0 lines-suffix 0 - buffer-size 0))) + buffer-size 0) + (update-line-data view))) (defmethod cache-string :around ((view drei-buffer-view)) (let ((string (call-next-method)))

1 0

[mcclim-cvs] CVS mcclim/Examples
by thenriksen 04 Mar '08

04 Mar '08

Update of /project/mcclim/cvsroot/mcclim/Examples In directory clnet:/tmp/cvs-serv9390/Examples Modified Files: method-browser.lisp Log Message: Applied method-browser fix from Willem Broekema for classes without prototypes. --- /project/mcclim/cvsroot/mcclim/Examples/method-browser.lisp 2006/03/29 09:36:30 1.3 +++ /project/mcclim/cvsroot/mcclim/Examples/method-browser.lisp 2008/03/04 07:54:13 1.4 @@ -75,15 +75,27 @@ #+CMU (typep x 'pcl::class) #+scl (typep x 'clos::std-class))) +;; FIXME: returns nil if there is both an EQL specializer and a +;; class specializer for which no prototype instance is available. (defun compute-applicable-methods-from-specializers (gf specializers) - (clim-mop:compute-applicable-methods gf - (mapcar (lambda (spec) - (cond ((typep spec 'clim-mop:eql-specializer) - (clim-mop:eql-specializer-object spec)) - ((classp spec) - (clim-mop:class-prototype spec)) - (t (error "Can't compute effective methods, specializer ~A is not understood." spec)))) - specializers))) + (if (every #'classp specializers) + (clim-mop:compute-applicable-methods-using-classes gf specializers) + (let ((instances + (mapcar (lambda (s) + (cond ((classp s) + ;; Implementation-dependent whether prototypes for + ;; built-in classes (like integer, t) are available. + (multiple-value-bind (prot err) + (ignore-errors (clim-mop:class-prototype s)) + (if err 'no-prototype prot))) + ((typep s 'clim-mop:eql-specializer) + (clim-mop:eql-specializer-object s)) + (t + (error "Can't compute effective methods, specializer ~A is not understood." + s)))) + specializers))) + (unless (member 'no-prototype instances) + (clim-mop:compute-applicable-methods gf instances))))) ;; FIXME: Support EQL specializers. ;; This is hard to do ideally, and I'm not really trying.

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 02 Mar '08

02 Mar '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv27840/Drei Modified Files: lisp-syntax.lisp Log Message: Fix form-to-object problem reported by Willem Broekema. --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/02/15 13:16:17 1.75 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/03/02 15:55:28 1.76 @@ -2903,7 +2903,7 @@ (list +quote-marker+ (apply #'form-to-object syntax (second (children form)) args)) `',(apply #'form-to-object syntax (second (children form)) args))) -(defmethod form-to-object (syntax (form incomplete-quote-form) &rest args) +(defmethod form-to-object ((syntax lisp-syntax) (form incomplete-quote-form) &rest args) (declare (ignore args)) ;; Utterly arbitrary, but reasonable in my opinion. '(quote))

1 0

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

19 Feb '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv11072 Modified Files: gadgets.lisp Log Message: Fixed division-by-zero bug in scrollbar code. --- /project/mcclim/cvsroot/mcclim/gadgets.lisp 2007/08/21 22:09:01 1.107 +++ /project/mcclim/cvsroot/mcclim/gadgets.lisp 2008/02/19 22:26:06 1.108 @@ -1463,7 +1463,7 @@ (let ((ts (scroll-bar-thumb-size sb))) ;; This is the right spot to handle ts = :none or perhaps NIL (multiple-value-bind (range) (gadget-range sb) - (let ((ts-in-pixels (round (* (- y3 y1) (/ ts (+ range ts)))))) ;### range + ts = 0? + (let ((ts-in-pixels (round (* (- y3 y1) (/ ts (max 1 (+ range ts))))))) ; handle range + ts = 0 (setf ts-in-pixels (min (- y3 y1) ;thumb can't be larger than the thumb bed (max +minimum-thumb-size-in-pixels+ ;but shouldn't be smaller than this. ts-in-pixels)))

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 18 Feb '08

18 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv26794/Drei Modified Files: drei-redisplay.lisp Log Message: Fix :to-line-end keyword parameter for invalidate-strokes-in-region. --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/02/17 14:54:47 1.67 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/02/18 12:22:47 1.68 @@ -344,11 +344,10 @@ :cleared cleared) ;; Only part of the line is within the region. else do (do-displayed-line-strokes (stroke line) - (when (if to-line-end - (<= start-offset (stroke-start-offset stroke)) - (overlaps start-offset end-offset - (stroke-start-offset stroke) - (stroke-end-offset stroke))) + (when (overlaps start-offset + (if to-line-end (line-end-offset line) end-offset) + (stroke-start-offset stroke) + (stroke-end-offset stroke)) (invalidate-stroke stroke :modified modified :cleared cleared))) if (= line1-index line2-index) do (loop-finish)

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 18 Feb '08

18 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv4903/Drei Modified Files: lisp-syntax-swine.lisp Log Message: Added support for undefing command and undefiners. n metacircular uninterpreter! --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-swine.lisp 2008/02/16 22:06:09 1.17 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-swine.lisp 2008/02/18 10:45:26 1.18 @@ -956,6 +956,26 @@ `undefiner'. If it isn't, the results are undefined. `Syntax' is the Lisp syntax object that has `definition-form'.")) +(defvar *undefiners* (make-hash-table) + "A hash table mapping operators to undefiners. The undefiners +are instances of `undefiner'.") + +(defun get-undefiner (definition-type) + "Return the undefiner for `definition-type', which must be a +symbol. Returns NIL if there is no undefiner of the given type." + (values (gethash definition-type *undefiners*))) + +(defun invalid-form-for-type (syntax form type-name) + "Signal a `form-conversion-error' describing the fact that +`form' cannot define a `type-name'." + (form-conversion-error syntax form "Form cannot define a ~A." type-name)) + +(defun invalid-form (undefiner syntax form) + "Signal a `form-conversion-error' describing the fact that +`form' cannot define whatever kind of definition `undefiner' +handles." + (invalid-form-for-type syntax form (undefiner-type undefiner))) + (defclass simple-undefiner (undefiner) ((%undefiner-type :reader undefiner-type :initform (error "A description must be provided.") @@ -972,7 +992,7 @@ :initarg :undefiner-function))) (defmethod definition-name ((undefiner simple-undefiner) (syntax lisp-syntax) (form form)) - (form-conversion-error syntax form "Form ~A cannot define a ~A." (undefiner-type undefiner))) + (invalid-form undefiner syntax form)) (defmethod definition-name ((undefiner simple-undefiner) (syntax lisp-syntax) (form list-form)) (if (>= (length (form-children form)) 2) @@ -984,15 +1004,6 @@ (definition-name undefiner syntax form) form)) -(defvar *undefiners* (make-hash-table) - "A hash table mapping operators to undefiners. The undefiners -are instances of `undefiner'.") - -(defun get-undefiner (definition-type) - "Return the undefiner for `definition-type', which must be a -symbol. Returns NIL if there is no undefiner of the given type." - (values (gethash definition-type *undefiners*))) - (defmacro define-simple-undefiner (definition-spec (syntax-sym name-sym form-sym) &body body) "Define a way to undefine some definition. `Definition-spec' is the operator (like `defun', `defclass', etc), and `syntax-sym', @@ -1014,6 +1025,82 @@ (declare (ignorable ,syntax-sym ,name-sym ,form-sym)) ,@body))))) +(defclass generic-undefiner (undefiner) + ((%undefiner-type :reader undefiner-type + :initform (error "A description must be provided.") + :type string + :documentation "A textual, user-oriented name +for the type of definition handled by this +undefiner." + :initarg :undefiner-type) + (%name-function :reader name-function + :initform (error "A name retrieval function must be provided.") + :documentation "A function of three arguments: +the syntax object and the form to retrieve a name from. Should +return the name as a Lisp object (probably a symbol). Should +signal a `form-conversion-error' if the form cannot define +whatever type this undefiner handles." + :initarg :name-function) + (%undefiner-function :reader undefiner-function + :initform (error "An undefiner function must be provided.") + :documentation "A function of three +arguments: the syntax object, the name of the definition to be +undefined and the form to be undefined." + :initarg :undefiner-function))) + +(defmethod definition-name ((undefiner generic-undefiner) (syntax lisp-syntax) (form form)) + (funcall (name-function undefiner) syntax form)) + +(defmethod undefine ((undefiner generic-undefiner) (syntax lisp-syntax) (form form)) + (funcall (undefiner-function undefiner) syntax + (definition-name undefiner syntax form) + form)) + +(defmacro define-undefiner (definition-spec + ((name-syntax-sym name-form-sym) &body name-body) + ((undef-syntax-sym undef-name-sym undef-form-sym) + &body undefiner-body)) + "Define a way to undefine definitions. `Definition-spec' is the +operator (like `defun', `defclass', etc) and may optionally be a +list, in which case the first element is the operator, and the +second a user-oriented name for the kind of thing defined by the +operator. `Name-body' and `Undefiner-body' will be evaluated to +retrieve the name and perform the undefinition, respectively. + +`Name-syntax-sym' and `name-form-sym' will be bound to the Lisp +syntax instance and the entire form of the definition during +evaluation of `name-body'. Syntactical problems (such as an +incomplete or invalid form) should be signalled by an +invocation `(invalid)' + +`undef-syntax-sym', `undef-name-sym' and `undef-form-sym' will be +bound to the Lisp syntax instance, the name of the definition to +be undefined and the entire form of the definition when +`undefiner-body' is evaluated. Syntactical problems (such as an +incomplete or invalid form) should be signalled by an +invocation `(invalid)'." + (check-type definition-spec (or list symbol)) + (let* ((definition-type (unlisted definition-spec)) + (undefiner-name (if (listp definition-spec) + (second definition-spec) + (string-downcase definition-type)))) + (check-type definition-type symbol) + `(setf (gethash ',definition-type *undefiners*) + (make-instance 'generic-undefiner + :undefiner-type ,undefiner-name + :name-function #'(lambda (,name-syntax-sym ,name-form-sym) + (declare (ignorable ,name-syntax-sym ,name-form-sym)) + (flet ((invalid () + (invalid-form-for-type ,name-syntax-sym ,name-form-sym ,undefiner-name))) + (declare (ignorable #'invalid)) + ,@name-body)) + :undefiner-function #'(lambda (,undef-syntax-sym ,undef-name-sym ,undef-form-sym) + (declare (ignorable ,undef-syntax-sym ,undef-name-sym ,undef-form-sym)) + (flet ((invalid () + (invalid-form-for-type ,undef-syntax-sym ,undef-form-sym ,undef-name-sym))) + (declare (ignorable #'invalid)) + ,@undefiner-body)))))) + (define-simple-undefiner (defun "function") (syntax name form) (fmakunbound name)) @@ -1065,3 +1152,50 @@ (define-simple-undefiner (defpackage "package") (syntax name form) (delete-package name)) + +(defun get-listed-name (syntax form) + "Retrieve the name of `form' under the assumption that the name +is the second element of `form', and if this is a list, the first +element of that list. The secondary value will be true if a name +can be found, false otherwise." + (if (and (form-list-p form) + (>= (length (form-children form)) 2)) + (let ((name-form (second (form-children form)))) + (cond ((and (form-list-p name-form) + (form-children name-form)) + (values (form-to-object syntax (first (form-children name-form))) t)) + ((form-token-p name-form) + (values (form-to-object syntax name-form) t)) + (t (values nil nil)))) + (values nil nil))) + +;; Cannot recognize the common define-FOO-command macros. +(define-undefiner (define-command "command") + ((syntax form) + (multiple-value-bind (name success) (get-listed-name syntax form) + (if success name (invalid)))) + ((syntax name form) + ;; Pick out the command table from the define-command form. The + ;; command may also be in other command tables, but we can't find + ;; those. + (let ((name-form (listed (form-to-object syntax (second (form-children form)))))) + (destructuring-bind (ignore &key command-table keystroke &allow-other-keys) name-form + (declare (ignore ignore)) + (when command-table + (remove-command-from-command-table name command-table :errorp nil) + (remove-keystroke-from-command-table command-table keystroke :errorp nil)))) + (fmakunbound name))) + +(define-undefiner (define-undefiner "undefiner") + ((syntax form) + (multiple-value-bind (name success) (get-listed-name syntax form) + (if success name (invalid)))) + ((syntax name form) + (remhash name *undefiners*))) + +(define-undefiner (define-simple-undefiner "simple undefiner") + ((syntax form) + (multiple-value-bind (name success) (get-listed-name syntax form) + (if success name (invalid)))) + ((syntax name form) + (remhash name *undefiners*)))

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