CLIM mail archive
[Prev][Next][Index][Thread]

accept questions

I have two questions relating to accept.

If I have something like:

(accept '(sequence (sequence number)))

How do I tell accept that I'm done with the first '(sequence number).
The only delimiter is comma and I can't figure out how to enter a
sequence which maps to ((1 2 3) (4 5 6)), all I can do is enter 1, 2,
3, 4, 5, 6   which maps to ((1 2 3 4 5 6)).

The second question has to do with multiple presentation-translators.
Given the code at the end of this message, I want an (accept 'names)
to accept an expression, such as (and john (or jane spot)), and I want
the user to be able to type '(and' and then click on thing1 to insert
john, and so on.  I also want (accept 'expression) to accept a lisp
expression and have clicking on thing1 insert '(1 2) into the
expression.  I can't seem to get this behaviour.  What happens is that
both the 'names context and the 'expression context cause clicking on
a thing to return the same slot.  I've tried playing around with
different :priorities, with :testers that checked if 'names was a
member of the context-type and with presentation-translators for names
which translated from thing to expression vs. thing to names, but none
of these worked.  What am I doing wrong?

Here is the code I use to test this:

;;;; -*- Mode:Common-Lisp; Package:CLIM-USER; Base:10 -*-

(in-package :clim-user)

;;;-----------------------------------------------------------------------

(defmacro make-clim-bug-demo (bug-name)
  (flet ((bugify (suffix)
	   (intern (format nil "~a-BUG-~a" bug-name suffix)))
	 (*bugify* (suffix)
	   (intern (format nil "*~a-BUG-~a*" bug-name suffix))))
    (let ((*root* (*bugify* 'root))
	  (*frame* (*bugify* 'frame))
	  (frame (bugify 'frame))
	  (invoker (bugify 'start))
	  (top-level (bugify 'top-level)))
      `(progn
	 (defvar ,*root* nil)
	 (defvar ,*frame* nil)
	 (clim:define-application-frame
	     ,frame () ()
	     (:command-table (,frame))
	     (:panes ((display :application)))
	     (:top-level (,top-level)))
	 (defun ,invoker (&optional reinit)
	   (flet ((open-root ()
		    ;;thanks to Oliver Christ <oli@adler.ims.uni-stuttgart.de>
		    ;;for the code below
		    #+Lucid (clim:open-root-window
			     :clx
			     :host (lcl:environment-variable "DISPLAY"))
		    #+Allegro-v4.1 (clim:open-root-window
				    :clx
				    :host (system:getenv "DISPLAY"))
		    #+MCL          (clim:open-root-window :mcl)
		    #+Genera       (clim:open-root-window :sheet)
		    ;;Please contact keunen@nrb.be if you modify this source
		    ;;code.
		    #-(or Lucid Allegro-v4.1 MCL Genera)
		    (warning "Unknown CLIM/LISP combination.  ~
 Please modify the `open-root' function to your needs.")))
	     (when (or reinit (null ,*root*) (null ,*frame*))
	       (setf ,*frame*
		 (clim:make-application-frame
		  ',frame :parent (setf ,*root* (open-root)))))
	     (clim:run-frame-top-level ,*frame*)))))))

;;;-----------------------------------------------------------------------

(progn

(make-clim-bug-demo accept)

(defclass thing ()
	  ((name :initarg :name :accessor name)
	   (value :initarg :value :accessor value)))

(defvar thing1 (make-instance 'thing :name 'john :value '(1 2)))
(defvar thing2 (make-instance 'thing :name 'jane :value '(3 4)))
(defvar thing3 (make-instance 'thing :name 'spot :value '(5 6)))

(define-presentation-type names () :inherit-from 'expression)

(define-presentation-translator thing-to-name
    (thing names accept-bug-frame
	   :gesture :select
	   :menu nil)
  (object)
  (name object))

(define-presentation-translator thing-to-value
    (thing expression accept-bug-frame
	   :gesture :select
	   :menu nil)
  (object)
  (value object))

(defmethod accept-bug-top-level (frame)
  (let ((stream (clim:get-frame-pane frame 'display)))
    (fresh-line stream)
    (present thing1 'thing :stream stream)
    (fresh-line stream)
    (present thing2 'thing :stream stream)
    (fresh-line stream)
    (present thing3 'thing :stream stream)
    (fresh-line stream)
    (print (accept 'names :stream stream) stream)
    (fresh-line stream)
    (print (accept 'expression :stream stream) stream)
    (fresh-line stream)
    (accept 'symbol :stream stream)))

)
Follow-Ups:
Main Index | Thread Index