/[cells]/cells-gtk/compat.lisp
ViewVC logotype

Contents of /cells-gtk/compat.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations)
Mon Jan 28 23:59:22 2008 UTC (6 years, 2 months ago) by ktilton
Branch: MAIN
CVS Tags: HEAD
*** empty log message ***
1 #|
2
3 Cells Gtk
4
5 Copyright (c) 2004 by Vasilis Margioulas <vasilism@sch.gr>
6
7 You have the right to distribute and use this software as governed by
8 the terms of the Lisp Lesser GNU Public License (LLGPL):
9
10 (http://opensource.franz.com/preamble.html)
11
12 This program is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 Lisp Lesser GNU Public License for more details.
16
17 |#
18
19 (in-package :cgtk)
20
21 ;;; From clocc port
22 ;;; N.B.: There is no guarantee that the wait function
23 ;;; will run in the stack group of the waiting process. So
24 ;;; you can't depend on dynamic bindings and catches being in effect.
25 (defun process-wait (whostate predicate &rest args)
26 "Sleep until PREDICATE becomes true."
27 #+Allegro (apply #'mp:process-wait whostate predicate args)
28 #+CMU (mp:process-wait whostate (lambda () (apply predicate args)))
29 #+LispWorks (apply #'mp:process-wait whostate predicate args))
30
31 ;;; From clocc port, but with additions and deletions
32 (defun process-wait-with-timeout (timeout whostate
33 &optional (predicate #'(lambda () t) pred-supplied-p)
34 &rest args)
35 #+allegro (declare (ignore pred-supplied-p))
36 "Sleep until PREDICATE becomes true, or for TIMEOUT seconds, whichever comes first."
37 #+Allegro
38 (apply #'mp:process-wait-with-timeout whostate timeout predicate args)
39 #+CMU (mp:process-wait-with-timeout
40 whostate timeout (lambda () (apply predicate args)))
41 #+LispWorks
42 (if pred-supplied-p
43 (apply #'mp:process-wait-with-timeout whostate timeout predicate args)
44 (mp:process-wait-with-timeout whostate timeout)))

  ViewVC Help
Powered by ViewVC 1.1.5