Update of /project/mcclim/cvsroot/mcclim In directory common-lisp:/tmp/cvs-serv4733

Modified Files: decls.lisp presentation-defs.lisp setf-star.lisp transforms.lisp Log Message:

Changed DEFGENERIC* and DEFMETHOD* to use a private name for the generic function defined. This avoids warnings from some systems that don't like having a defsetf macro and a setf function for the same place. This is an invasive change; *RECOMPILE YOUR FILES*.

Cleaned up some duplicate definitions in decls.lisp, transforms.lisp.

Integrated Troels Henriksen's patch for :insert-default in ACCEPT.

Date: Wed Jan 18 08:07:36 2006 Author: tmoore

Index: mcclim/decls.lisp diff -u mcclim/decls.lisp:1.34 mcclim/decls.lisp:1.35 --- mcclim/decls.lisp:1.34 Tue Dec 6 07:40:04 2005 +++ mcclim/decls.lisp Wed Jan 18 08:07:36 2006 @@ -99,9 +99,6 @@ (defgeneric rectangle-height (rectangle)) (defgeneric rectangle-size (rectangle))

- -(defgeneric transform-region (transformation region)) - ;;; 5.3.2 Composition of Transformations

(defgeneric compose-transformations (transformation1 transformation2))

Index: mcclim/presentation-defs.lisp diff -u mcclim/presentation-defs.lisp:1.49 mcclim/presentation-defs.lisp:1.50 --- mcclim/presentation-defs.lisp:1.49 Wed Jan 4 03:45:35 2006 +++ mcclim/presentation-defs.lisp Wed Jan 18 08:07:36 2006 @@ -810,7 +810,7 @@ (additional-activation-gestures nil additional-activations-p) (delimiter-gestures nil delimitersp) (additional-delimiter-gestures nil additional-delimiters-p)) - (declare (ignore provide-default insert-default history active-p + (declare (ignore provide-default history active-p prompt prompt-mode display-default query-identifier)) (when (and defaultp (not default-type-p)) @@ -830,6 +830,13 @@ (declare (ignore stream)) (funcall cont)))) (with-input-position (stream) ; support for calls to replace-input + (when insert-default + ;; Insert the default value to the input stream. It should + ;; become fully keyboard-editable. + (presentation-replace-input stream + default + default-type + view)) (setf (values sensitizer-object sensitizer-type) (with-input-context (type) (object object-type event options) @@ -846,10 +853,10 @@ (setq accept-results (multiple-value-list (if defaultp - (funcall-presentation-generic-function - accept type stream view - :default default - :default-type default-type) + (funcall-presentation-generic-function + accept type stream view + :default default + :default-type default-type) (funcall-presentation-generic-function accept type stream view)))) ;; User entered activation or delimeter @@ -897,6 +904,7 @@ &key (default nil defaultp) (default-type type) + (insert-default nil) (prompt t) (prompt-mode :normal) (display-default prompt) @@ -914,9 +922,12 @@ *recursive-accept-p* (describe-presentation-type type nil nil)) prompt)) - (default-string (if (and defaultp display-default) - (present-to-string default default-type) - nil))) + ;; Don't display the default in the prompt if it is to be + ;; inserted into the input stream. + (default-string (and defaultp + (not insert-default) + display-default + (present-to-string default default-type)))) (cond ((null prompt) nil) (t

Index: mcclim/setf-star.lisp diff -u mcclim/setf-star.lisp:1.2 mcclim/setf-star.lisp:1.3 --- mcclim/setf-star.lisp:1.2 Fri Mar 21 15:36:59 2003 +++ mcclim/setf-star.lisp Wed Jan 18 08:07:36 2006 @@ -23,6 +23,16 @@ (defun setf-name-p (name) (and (listp name) (eq (car name) 'setf)))

+;;; Many implementations complain if a defsetf definition and a setf function +;;; exist for the same place. Time to stop fighting that... + +(defun make-setf*-gfn-name (function-name) + (let* ((name-sym (cadr function-name))) + `(setf ,(intern (format nil ".~A-~A." + (symbol-name name-sym) + (symbol-name '#:star)) + (symbol-package name-sym))))) + (defmacro defgeneric* (fun-name lambda-list &body options) "Defines a SETF* generic function. FUN-NAME is a SETF function name. The last argument is the single argument to the function in a @@ -32,16 +42,17 @@ (error "~S is not a valid name for a SETF* generic function." fun-name)) (let ((setf-name (cadr fun-name)) (args (butlast lambda-list)) - (place (car (last lambda-list)))) + (place (car (last lambda-list))) + (gf (make-setf*-gfn-name fun-name))) `(progn (defsetf ,setf-name (,place) ,args - `(funcall #',',fun-name ,,@args ,,place)) - (defgeneric ,fun-name ,lambda-list ,@options)))) + `(funcall #',',gf ,,@args ,,place)) + (defgeneric ,gf ,lambda-list ,@options))))

(defmacro defmethod* (name &body body) "Defines a SETF* method. NAME is a SETF function name. Otherwise, like DEFMETHOD except there must exist a corresponding DEFGENERIC* form." (unless (setf-name-p name) (error "~S is not a valid name for a SETF* generic function." name)) - `(defmethod ,name ,@body)) + `(defmethod ,(make-setf*-gfn-name name) ,@body))

Index: mcclim/transforms.lisp diff -u mcclim/transforms.lisp:1.31 mcclim/transforms.lisp:1.32 --- mcclim/transforms.lisp:1.31 Fri Dec 16 10:42:15 2005 +++ mcclim/transforms.lisp Wed Jan 18 08:07:36 2006 @@ -4,7 +4,7 @@ ;;; Created: 1998-09-29 ;;; Author: Gilbert Baumann unk6@rz.uni-karlsruhe.de ;;; License: LGPL (See file COPYING for details). -;;; $Id: transforms.lisp,v 1.31 2005/12/16 16:42:15 rgoldman Exp $ +;;; $Id: transforms.lisp,v 1.32 2006/01/18 14:07:36 tmoore Exp $ ;;; -------------------------------------------------------------------------------------- ;;; (c) copyright 1998,1999,2003 by Gilbert Baumann ;;; (c) copyright 2000 by @@ -435,9 +435,6 @@

;;(defmacro with-local-coordinates ((medium &optional x y) &body body)) -- what are local coordinates? ;;(defmacro with-first-quadrant-coordinates ((medium &optional x y) &body body)) - -;;(defgeneric transform-region (transformation region)) - (defmacro with-identity-transformation ((medium) &body body) ;; I believe this should set the medium transformation to the identity ;; transformation. To use WITH-DRAWING-OPTIONS which concatenates the the