/[mcclim]/mcclim/dialog.lisp
ViewVC logotype

Diff of /mcclim/dialog.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.15 by ahefner, Sun Jan 2 05:24:49 2005 UTC revision 1.16 by tmoore, Tue Jan 11 13:02:19 2005 UTC
# Line 318  highlighting, etc." )) Line 318  highlighting, etc." ))
318          (when query          (when query
319            (setf selected-query query)            (setf selected-query query)
320            (select-query *accepting-values-stream* query (record query))            (select-query *accepting-values-stream* query (record query))
321            (if (cdr query-list)            (let ((command-ptype '(command :command-table accepting-values)))
322                (throw-object-ptype (query-identifier (cadr query-list))              (if (cdr query-list)
323                                    'selectable-query)                (throw-object-ptype `(com-select-query ,(query-identifier
324                (throw-object-ptype '(com-deselect-query)                                                         (cadr query-list)))
325                                    '(command :command-table accepting-values))))))))                                    command-ptype)
326                  (throw-object-ptype '(com-deselect-query) command-ptype))))))))
327    
328  (define-command (com-deselect-query :command-table accepting-values  (define-command (com-deselect-query :command-table accepting-values
329                                      :name nil                                      :name nil
# Line 345  is called. Used to determine if any edit Line 346  is called. Used to determine if any edit
346    
347  (defparameter *no-default-cache-value* (cons nil nil))  (defparameter *no-default-cache-value* (cons nil nil))
348    
349    ;;; Hack until more views / dialog gadgets are defined.
350    
351    (define-default-presentation-method accept-present-default
352        (type stream (view text-field-view) default default-supplied-p
353         present-p query-identifier)
354      (if (width view)
355          (multiple-value-bind (cx cy)
356              (stream-cursor-position stream)
357            (declare (ignore cy))
358            (letf (((stream-text-margin stream) (+ cx (width view))))
359              (funcall-presentation-generic-function accept-present-default
360                                                     type
361                                                     stream
362                                                     +textual-dialog-view+
363                                                     default default-supplied-p
364                                                     present-p
365                                                     query-identifier)))))
366    
367  (define-default-presentation-method accept-present-default  (define-default-presentation-method accept-present-default
368      (type stream (view textual-dialog-view) default default-supplied-p      (type stream (view textual-dialog-view) default default-supplied-p
369       present-p query-identifier)       present-p query-identifier)

Legend:
Removed from v.1.15  
changed lines
  Added in v.1.16

  ViewVC Help
Powered by ViewVC 1.1.5