[mcclim-cvs] CVS update: mcclim/decls.lisp mcclim/presentation-defs.lisp mcclim/setf-star.lisp mcclim/transforms.lisp
Timothy Moore
tmoore at common-lisp.net
Wed Jan 18 14:07:37 UTC 2006
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 ,, at args ,,place))
- (defgeneric ,fun-name ,lambda-list , at options))))
+ `(funcall #',',gf ,, at args ,,place))
+ (defgeneric ,gf ,lambda-list , at 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 , at body))
+ `(defmethod ,(make-setf*-gfn-name name) , at 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 at 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
More information about the Mcclim-cvs
mailing list