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

Contents of /mcclim/dialog.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations)
Sun Jul 14 03:24:29 2002 UTC (11 years, 9 months ago) by adejneka
Branch: MAIN
Added stub for ACCEPTING-VALUES.
1 adejneka 1.1 ;;; Stub for ACCEPTING-VALUES.
2    
3     (in-package :CLIM-INTERNALS)
4    
5     (defmacro accepting-values
6     ((&optional (stream t)
7     &rest args
8     &key own-window exit-boxes initially-select-query-identifier
9     modify-initial-query resynchronize-every-pass resize-frame
10     align-prompts label scroll-bars
11     x-position y-position width height command-table frame-class)
12     &body body)
13     (declare (ignorable own-window exit-boxes initially-select-query-identifier
14     modify-initial-query resynchronize-every-pass resize-frame
15     align-prompts label scroll-bars
16     x-position y-position width height command-table frame-class))
17     (when (eq stream 't)
18     (setq stream '*standard-input*))
19     (check-type stream symbol)
20     (with-gensyms (accepting-values-continuation)
21     `(flet ((,accepting-values-continuation (,stream)
22     ,@body))
23     (declare (dynamic-extent ,accepting-values-continuation))
24     (invoke-accepting-values ,stream
25     #',accepting-values-continuation
26     ,@args))))
27    
28     (defun invoke-accepting-values
29     (stream body
30     &key own-window exit-boxes initially-select-query-identifier
31     modify-initial-query resynchronize-every-pass resize-frame
32     align-prompts label scroll-bars
33     x-position y-position width height command-table
34     (frame-class 'accept-values))
35     (funcall body stream))
36    

  ViewVC Help
Powered by ViewVC 1.1.5