[q-lang-cvs] qcalc calclib.q,1.25,1.26 qcalc.q,1.143,1.144

[Albert G. <ag...@us...>]

Update of /cvsroot/q-lang/qcalc
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv16041

Modified Files:
	calclib.q qcalc.q 
Log Message:
added 'task button' GUI element, minor bugfixes

Index: qcalc.q
===================================================================
RCS file: /cvsroot/q-lang/qcalc/qcalc.q,v
retrieving revision 1.143
retrieving revision 1.144
diff -C2 -d -r1.143 -r1.144
*** qcalc.q	13 Nov 2007 11:52:27 -0000	1.143
--- qcalc.q	15 Nov 2007 00:08:33 -0000	1.144
***************
*** 178,183 ****
    qt TIMER "start" 300,
    // some pixmaps
!   [FLAG, RES, NULLPM] = map (qt_new "QPixmap")
!   [which "pixmaps/flag.png", which "pixmaps/1rightarrow.png", ()],
    // dictionary of edited and computed cells
    CELLS = ref emptyhdict, EVAL = ref emptyhdict, XREF = ref emptyhdict,
--- 178,188 ----
    qt TIMER "start" 300,
    // some pixmaps
!   [FLAG, RES, TASKB, TASKA, NULLPM] = map (qt_new "QPixmap")
!   [which "pixmaps/flag.png",
!    which "pixmaps/1rightarrow.png",
!    which "pixmaps/1rightarrow.png",
!    which "pixmaps/1rightarrow-green.png",
!    ()],
!   TASKPM = [TASKB,TASKA],
    // dictionary of edited and computed cells
    CELLS = ref emptyhdict, EVAL = ref emptyhdict, XREF = ref emptyhdict,
***************
*** 776,779 ****
--- 781,790 ----
  		      (reg 1,reg 2),
  		      (I,J) = val K;
+ 		= qt X "setIconSet" ICONSET
+ 		    where [(K,S)] = regex ""
+ 		      "^\\+\\+\\+ Taskstate: (\\([0-9]+,[0-9]+\\)) ([0-9]+)$" S
+ 		      (reg 1,reg 2),
+ 		      (I,J) = val K, Y = val S, X = gui_elem (I,J),
+ 		      ICONSET = qt_new "QIconSet" (TASKPM!Y);
  		= qt LOG "append" S || qt LOG "scrollToBottom" ()
  		    otherwise;
***************
*** 1055,1059 ****
--- 1066,1076 ----
  		  qt TABLE "clearSelection" ();
  
+ private yytask KEY MSG;
+ 
  clear_cell (I,J)
+ where X:QtObject = gui_elem (I,J), ("MyTaskButton"|_) = qt_mob_data X:
+ 		= // nuke an existing background thread
+ 		  send_expr '(yytask (I,J) ()) ||
+ 		  fail; // falls through to below
  if (I,J) = real_index (I,J):
  		= qt TABLE "clearCell" (I,J) if not has_table_item (I,J);
***************
*** 1101,1105 ****
  where (I,J) = real_index (I,J)
  if is_global and then not is_recursive:
! 		= process_gui (I,J) X || digest_loop
  		    where X:QtObject = gui_elem (I,J);
  		= post MSGS '(check_last_gui (I,J,X))
--- 1118,1122 ----
  where (I,J) = real_index (I,J)
  if is_global and then not is_recursive:
! 		= process_gui2 (I,J) X || digest_loop
  		    where X:QtObject = gui_elem (I,J);
  		= post MSGS '(check_last_gui (I,J,X))
***************
*** 1188,1196 ****
  
  gui_update X (I,J) _
! where (I,J) = real_index (I,J)
  if is_global and then not is_recursive and then not is_nil X:
  		= if (I,J)<>real_current_cell then
  		    set_current_cell (I,J) ||
! 		  process_gui (I,J) X || digest_loop;
  
  check_editing	= EDITED := true ||
--- 1205,1215 ----
  
  gui_update X (I,J) _
! where (I,J) = real_index (I,J), (CC|_) = qt_mob_data X
  if is_global and then not is_recursive and then not is_nil X:
  		= if (I,J)<>real_current_cell then
  		    set_current_cell (I,J) ||
! 		  if CC = "MyTaskButton" then
! 		    send_expr '(yytask (I,J) ~(qt X "isOn" ())) ||
! 		  process_gui2 (I,J) X || digest_loop;
  
  check_editing	= EDITED := true ||
***************
*** 2457,2460 ****
--- 2476,2499 ----
  		      ICONSET = qt_new "QIconSet" PM;
  
+ taskbutton_gui (I,J) () (TEXT,INIT)
+ 		= qt X "setToggleButton" true ||
+ 		  qt X "setOn" INIT ||
+ 		  qt_connect X (SIGNAL "toggled(bool)")
+ 		  X (SLOT "guiUpdate()") ||
+ 		  qt TABLE "setCellWidget" (I,J,X) || IT
+ 		    if not is_nil IT and then not is_nil X
+ 		    where ICONSET = qt_new "QIconSet" TASKB,
+ 		      X:QtObject = qt_object "QPushButton"
+ 		      (if is_qt_object ICONSET then (ICONSET,TEXT,TABLE)
+ 		       else (TEXT,TABLE))
+ 		      "MyTaskButton" (I,J) []
+ 		      // slots
+ 		      [("guiUpdate()",gui_update)] [],
+ 		      IT:QtObject = make_table_item (I,J,X)
+ 		      (qt_val "QTableItem" "Never");
+ 
+ taskbutton_gui (I,J) X:QtObject (TEXT,INIT)
+ 		= qt X "setText" TEXT || qt X "setOn" INIT;
+ 
  spinbox_gui (I,J) () (MIN,MAX,STEP,INIT,SPECIAL,PREF,SUFF,V2T,T2V)
  		= // FIXME: implement more appropriate validation here
***************
*** 2540,2545 ****
  		= slider_gui
  		    if C = "QSlider";
! 		= if qt X "isToggleButton" () then togglebutton_gui
  		  else pushbutton_gui
  		    if C = "QPushButton";
  //		= printf "unknown GUI element %s\n" C || fail otherwise;
--- 2579,2586 ----
  		= slider_gui
  		    if C = "QSlider";
! 		= if CC = "MyTaskButton" then taskbutton_gui
! 		  else if qt X "isToggleButton" () then togglebutton_gui
  		  else pushbutton_gui
+ 		    where (CC|_) = qt_mob_data X
  		    if C = "QPushButton";
  //		= printf "unknown GUI element %s\n" C || fail otherwise;
***************
*** 2605,2614 ****
  		    if checknum 'Y where 'Y = valq S
  		    if C = "QSlider";
  		= qt X "setOn" Y
  		    if checkbool 'Y where 'Y = valq S
  		    if (C = "QPushButton") and then qt X "isToggleButton" ();
  		= () if C = "QPushButton";
! 		= //printf "bad value %s for GUI element %s\n" (str S,C) ||
! 		  () otherwise;
  
  // Convert a spinbox value; use the special value text and the text->value
--- 2646,2662 ----
  		    if checknum 'Y where 'Y = valq S
  		    if C = "QSlider";
+ 		= if checkstr 'Y then
+ 		    qt X "setText" Y
+ 		  else if checkbool 'Y then
+ 		    qt X "setOn" Y
+ //		  else printf "bad value %s for GUI element %s\n" (str S,C)
+ 		    where ("MyTaskButton"|_) = qt_mob_data X, 'Y = valq S
+ 		    if (C = "QPushButton") and then qt X "isToggleButton" ();
  		= qt X "setOn" Y
  		    if checkbool 'Y where 'Y = valq S
  		    if (C = "QPushButton") and then qt X "isToggleButton" ();
  		= () if C = "QPushButton";
! //		= printf "bad value %s for GUI element %s\n" (str S,C);
! 		= () otherwise;
  
  // Convert a spinbox value; use the special value text and the text->value
***************
*** 2631,2635 ****
  		    (qt X "setStringList" $ append L S ||
  		     qt X "setCurrentItem" N) ||
! 		  process_gui (I,J) X || digest_loop
  		    where S = qt X "currentText" (),
  		      N = qt X "count" (), L = map (qt X "text") [0..N-1]
--- 2679,2683 ----
  		    (qt X "setStringList" $ append L S ||
  		     qt X "setCurrentItem" N) ||
! 		  process_gui2 (I,J) X || digest_loop
  		    where S = qt X "currentText" (),
  		      N = qt X "count" (), L = map (qt X "text") [0..N-1]
***************
*** 2638,2642 ****
  		= // confine the value to the given range and step size
  		  if Y<>Y0 then recursive (qt X "setValue" Y) ||
! 		  process_gui (I,J) X || digest_loop
  		    where Y0 = qt X "value" (),
  		      MIN = qt X "minValue" (),
--- 2686,2690 ----
  		= // confine the value to the given range and step size
  		  if Y<>Y0 then recursive (qt X "setValue" Y) ||
! 		  process_gui2 (I,J) X || digest_loop
  		    where Y0 = qt X "value" (),
  		      MIN = qt X "minValue" (),
***************
*** 3055,3059 ****
     and the executing script). */
  
! private yyeval KEY X, yyset KEY X, yyclear X, yyval KEY;
  
  parse S		= 'X
--- 3103,3107 ----
     and the executing script). */
  
! private yyeval KEY X, yyset KEY X, yyclear X, yyval KEY, yytask KEY MSG;
  
  parse S		= 'X
***************
*** 3239,3242 ****
--- 3287,3297 ----
  		= results_loop (insert U ((I1,J1),IT)) [(I,J)|V]
  		    where [(K1,S1)] = regex ""
+ 		      "^\\+\\+\\+ Taskbutton: (\\([0-9]+,[0-9]+\\)) (.*)$" S
+ 		      (reg 1,reg 2),
+ 		      (I1,J1) = val K1, (TEXT,INIT) = val S1,
+ 		      IT:QtObject = make_gui taskbutton_gui (I1,J1)
+ 		      (TEXT,INIT);
+ 		= results_loop (insert U ((I1,J1),IT)) [(I,J)|V]
+ 		    where [(K1,S1)] = regex ""
  		      "^\\+\\+\\+ Combobox: (\\([0-9]+,[0-9]+\\)) (.*)$" S
  		      (reg 1,reg 2),
***************
*** 3343,3353 ****
  
  process_gui (I,J) X
! 		= // set the new value in the inferior process
! 		  // (check whether the value is actually transferable)
! 		  if checkval X then submit_val (I,J) X ||
! 		  // do the necessary reevaluations
! 		  if check_interp then compute V
! 		    where V = eval_list (cst false) (I,J),
! 		      X = gui_getval X;
  
  process1 (I,J,S)
--- 3398,3410 ----
  
  process_gui (I,J) X
! 		= if check_interp then compute V
! 		    where V = eval_list (cst false) (I,J);
! 
! process_gui2 (I,J) X
! 		= // make sure that the new value is set in the inferior
! 		  // process (also check that the value is transferable)
! 		  if checkval Y then submit_val (I,J) Y ||
! 		  process_gui (I,J) X
! 		    where Y = gui_getval X;
  
  process1 (I,J,S)

Index: calclib.q
===================================================================
RCS file: /cvsroot/q-lang/qcalc/calclib.q,v
retrieving revision 1.25
retrieving revision 1.26
diff -C2 -d -r1.25 -r1.26
*** calclib.q	10 Nov 2007 13:42:12 -0000	1.25
--- calclib.q	15 Nov 2007 00:08:33 -0000	1.26
***************
*** 6,16 ****
     operations of this module in your spreadsheet script.
  
!    However, for QCalc to work properly, this script needs to be on the QPATH,
     therefore it is recommended that you install QCalc under the prefix where
     your Q installation lives. Otherwise you will have to set your QPATH
     accordingly. */
  
- /* Public access operations for use in spreadsheets. */
- 
  /* Access the row and column indices of the cell currently being computed.
     The index function returns both indices as a pair (I,J) where I and J are
--- 6,14 ----
     operations of this module in your spreadsheet script.
  
!    Note that for QCalc to work properly, this script needs to be on the QPATH,
     therefore it is recommended that you install QCalc under the prefix where
     your Q installation lives. Otherwise you will have to set your QPATH
     accordingly. */
  
  /* Access the row and column indices of the cell currently being computed.
     The index function returns both indices as a pair (I,J) where I and J are
***************
*** 35,42 ****
  
     The most useful routine is the cellindex function which can be used with a
!    quoted cell symbol to embed symbolic cell names used as parameters to
!    functions like setval into formulas, where they are adjusted automatically
!    when copied or filled (actually, this conversion is done by setval et al
!    automagically). */
  
  public cellindex X, cellstr KEY, cellname KEY;
--- 33,40 ----
  
     The most useful routine is the cellindex function which can be used with a
!    quoted cell symbol to embed symbolic cell names into formulas, where they
!    are adjusted automatically when copied or filled (this conversion is
!    already built into setval et al, so you do not have to use cellindex
!    explicitly for these). */
  
  public cellindex X, cellstr KEY, cellname KEY;
***************
*** 49,53 ****
  /* Definition of GUI elements in table cells. Currently supported are
     checkboxes, comboboxes (both non-editable and editable), spinboxes,
!    horizontal and vertical sliders, push and toggle buttons.
  
     The argument tuple ARGS depends on the specific kind of widget:
--- 47,51 ----
  /* Definition of GUI elements in table cells. Currently supported are
     checkboxes, comboboxes (both non-editable and editable), spinboxes,
!    horizontal and vertical sliders, push buttons and toggle buttons.
  
     The argument tuple ARGS depends on the specific kind of widget:
***************
*** 142,149 ****
    hslider ARGS, vslider ARGS, pushbutton ARGS, togglebutton ARGS;
  
  /* Set a cell value (and return that value). The given cell index KEY can
     either be in the numeric format as returned by the index function or in any
     of the symbolic formats supported by the cellindex routine (see above), and
!    X may be any Q expression.  If the given cell is an ordinary cell (no GUI
     element), then the current cell value is overwritten, so you should make
     sure that you do not have important data there. For GUI elements, the value
--- 140,216 ----
    hslider ARGS, vslider ARGS, pushbutton ARGS, togglebutton ARGS;
  
+ /* The task button is a special toggle button with an associated background
+    task (Q thread) to be executed in the inferior Q process. The ARGS
+    parameter is the same as for togglebutton, without the ICON parameter
+    (instead, the icon on the button is set and animated automatically in
+    response to the current activation status of the thread). The special X
+    parameter is the Q expression to be evaluated by the task.
+ 
+    Inside the background task, the task_input, task_index, task_row and
+    task_column functions are available to provide the input semaphore and the
+    cell index of the task, respectively. (Note that the index, row and column
+    functions don't work in background tasks, they can only be used inside
+    formulas, so you have to use task_index, task_row and task_column instead.
+    Also note that these values are only available in the original background
+    task started by the taskbutton function; if your task in turn creates other
+    threads which need to access these values, you have to pass them on to the
+    secondary threads.)
+ 
+    The task_input semaphore is a Q semaphore queue used to communicate values
+    to the executing task in response to GUI actions inside QCalc. Usually
+    these are either 'true' or 'false', and are sent when the button state
+    changes (true = button is switched on, i.e. the task was "started" by the
+    user; false = button is off, the task was "stopped" or "paused"). The
+    background task can respond to these by taking some appropriate action,
+    e.g., pause operation (or terminate altogether) if the 'false' value is
+    sent, or resume operation (if still active) when 'true' is sent. Note that
+    it is completely up to the task how it actually responds to these messages,
+    if at all. However, it is a good idea to have the task at least empty the
+    semaphore in regular time intervals to prevent the semaphore from being
+    flooded with useless messages. (In any case the semaphore queue will be
+    initially empty when the tread is started.)
+ 
+    The task_input semaphore may also yield a quoted expression value to
+    indicate that the task button itself was updated while the task is still
+    running. This happens when a triggered update of the button is caused by
+    some requisite cells of the task button formula changing values. In such a
+    case, rather than reexecuting the taskbutton function and restarting the
+    task from scratch, the button's X parameter is send via the semaphore as a
+    quoted expression. Again, it is completely up to the task how it handles
+    such messages. It may completely ignore the message, but a more appropriate
+    response would be to just replace itself with the sent expression.
+    Alternatively, the task may update its own internal state accordingly and
+    continue processing. In the latter case, it is often convenient to employ
+    the standard library special form 'case' to extract the needed values from
+    the quoted expression.
+ 
+    At any time, the background task can also send values back to the hosting
+    QCalc process, using the setval function (see below) with task_index as the
+    KEY argument. For instance, you can do a 'setval task_index false' to
+    indicate that processing has finished and the task is stopped (this is also
+    done automatically when the thread terminates). Currently, the recognized
+    values to be sent back are 'false' (the task is stopped), 'true' (the task
+    has been started, maybe in response to an asynchronous event), and
+    arbitrary string values (which change the text label shown on the task
+    button). QCalc will update the button in response to these messages and
+    also change the cell value of the task button accordingly, which may
+    trigger updates in other, dependent cells, see the description of the
+    setval function below for further details.
+ 
+    Note that, no matter what the purported "start/stopped" status of the
+    button is, the user can always check whether the task associated with the
+    button is currently up and running by taking a look at the arrow symbol
+    shown on the button. If the task is still executing, the arrow symbol will
+    be "lit" in green, otherwise it will be greyed out. Also note that in the
+    latter case, if the thread has exited when the user starts it by pressing
+    the button, the task will be restarted automatically. */
+ 
+ public special taskbutton ~ARGS X;
+ public task_input, task_index, task_row, task_column;
+ 
  /* Set a cell value (and return that value). The given cell index KEY can
     either be in the numeric format as returned by the index function or in any
     of the symbolic formats supported by the cellindex routine (see above), and
!    X may be any Q expression. If the given cell is an ordinary cell (no GUI
     element), then the current cell value is overwritten, so you should make
     sure that you do not have important data there. For GUI elements, the value
***************
*** 159,166 ****
     the given list value. For the matrix function, Xs must be a list of lists
     which are all of the same size; the component lists become the rows of the
!    matrix. rowvect and colvect are convenience functions to create matrices
!    with just one row or column for a given list of values, respectively. In
!    any case the matrix or vector is inserted into the table starting at the
!    given index KEY (given in any of the formats supported by setval). */
  
  public matrix KEY Xs, rowvect KEY Xs, colvect KEY Xs;
--- 226,234 ----
     the given list value. For the matrix function, Xs must be a list of lists
     which are all of the same size; the component lists become the rows of the
!    matrix. The rowvect and colvect routines are convenience functions to
!    create matrices with just one row or column for a given list of values,
!    respectively. In any case the matrix or vector is inserted into the table
!    starting at the given index KEY (given in any of the formats supported by
!    setval). */
  
  public matrix KEY Xs, rowvect KEY Xs, colvect KEY Xs;
***************
*** 175,179 ****
  var YYDATA = ref emptyhdict, YYKEY = ref ();
  
! public yymain, yyval KEY, yyset KEY VAL, yyclear KEY;
  public special yyeval ~KEY VAL;
  private yyloop, yyout X, yyerror X;
--- 243,247 ----
  var YYDATA = ref emptyhdict, YYKEY = ref ();
  
! public yymain, yyval KEY, yyset KEY VAL, yyclear KEY, yytask KEY MSG;
  public special yyeval ~KEY VAL;
  private yyloop, yyout X, yyerror X;
***************
*** 366,369 ****
--- 434,479 ----
  		    where (I,J) = get YYKEY;
  
+ /* The task button. */
+ 
+ var YYTASKS = ref emptyhdict, YYSEM = ref emptyhdict;
+ 
+ task_input	= SEM
+ 		    where (I,J,SEM) = get YYSEM!thread_no this_thread;
+ task_index	= (I,J)
+ 		    where (I,J,SEM) = get YYSEM!thread_no this_thread;
+ task_row	= I where (I,J) = task_index;
+ task_column	= J where (I,J) = task_index;
+ 
+ private begin_task ARGS, end_task;
+ 
+ taskbutton S:String X
+ 		= taskbutton (S,false) X;
+ taskbutton (S:String,INIT:Bool) X
+ where (I,J) = get YYKEY:
+ // update an old task if still present
+ 		= do (yytask (I,J)) ['X,INIT] ||
+ 		  printf "\f+++ Taskbutton: %s %s\n"
+ 		  (str (I,J),str (S,INIT)) || yyset (I,J) INIT || INIT
+ 		    where (H,_,'_) = get YYTASKS!(I,J);
+ // start up a new task
+ 		= YYTASKS := insert (get YYTASKS) (I,J;H,SEM,'X) ||
+ 		  post SEM INIT ||
+ 		  printf "\f+++ Taskbutton: %s %s\n"
+ 		  (str (I,J),str (S,INIT)) || yyset (I,J) INIT || INIT
+ 		    where SEM:Semaphore = semaphore,
+ 		      H:Thread =
+ 		      thread (begin_task (I,J,SEM) || catch id X || end_task);
+ 
+ /* Watchdogs for the beginning and end of a task. */
+ 
+ begin_task (I,J,SEM)
+ 		= YYSEM := insert (get YYSEM)
+ 		  (thread_no this_thread,(I,J,SEM)) ||
+ 		  printf "\f+++ Taskstate: %s 1\n" (str (I,J));
+ 
+ end_task	= setval (I,J) false ||
+ 		  printf "\f+++ Taskstate: %s 0\n" (str (I,J))
+ 		    where (I,J) = task_index;
+ 
  /* setval and friends. */
  
***************
*** 416,422 ****
  yyset KEY VAL
  = //printf "INTERP: SET %s := %s\n" (cellstr KEY,str VAL) || flush ||
!   YYDATA := insert (get YYDATA) (KEY,VAL) || VAL
      where VAL = YYKEY := KEY || VAL;
  yyclear KEY
  = //printf "INTERP: CLEAR %s\n" (cellstr KEY) || flush ||
    YYDATA := delete (get YYDATA) KEY;
--- 526,584 ----
  yyset KEY VAL
  = //printf "INTERP: SET %s := %s\n" (cellstr KEY,str VAL) || flush ||
!   YYDATA := insert (get YYDATA) (KEY,VAL) || YYKEY := () || VAL
      where VAL = YYKEY := KEY || VAL;
  yyclear KEY
  = //printf "INTERP: CLEAR %s\n" (cellstr KEY) || flush ||
    YYDATA := delete (get YYDATA) KEY;
+ 
+ /* Substitute cell values into task expressions. */
+ 
+ special subst X;
+ 
+ subst ''X	= ''X;
+ subst '(yyval (I,J))
+ 		= 'X where X = yyval (I,J);
+ 
+ subst '(X Y)	= '(`(subst 'X) `(subst 'Y));
+ subst '(X|Y)	= '(`(subst 'X)|`(subst 'Y));
+ subst '[X|Y]	= '[`(subst 'X)|`(subst 'Y)];
+ subst '{X|Y}	= '{`(subst 'X)|`(subst 'Y)};
+ 
+ subst 'X	= 'X otherwise;
+ 
+ /* These are sent by the parent process to update and abolish a task. */
+ 
+ /* Update a task with a new started/stopped status. */
+ 
+ yytask (I:Int,J:Int) B:Bool
+ where (H,SEM,'X) = get YYTASKS!(I,J):
+ // thread is still alive and kicking; pass the message
+ 		= post SEM B if isthread H and then active H;
+ // thread has terminated and is activated again, restart it
+ 		= YYTASKS := insert (get YYTASKS) (I,J;H,SEM,'X)
+ 		    where SEM:Semaphore = semaphore,
+ 		      H:Thread =
+ 		      thread (begin_task (I,J,SEM) || catch id X || end_task)
+ 		    if B;
+ // thread has terminated and is deactivated, put it in limbo
+ 		= YYTASKS := insert (get YYTASKS) (I,J;(),(),'X) ||
+ 		  YYSEM := delete (get YYSEM) (thread_no H)
+ 		    if isthread H;
+ 
+ /* Update a task with a new thread expression. */
+ 
+ yytask (I:Int,J:Int) 'X
+ where (H,SEM,'_) = get YYTASKS!(I,J):
+ 		= puts "Task updated\n" || fail;
+ 		= post SEM (subst 'X) if isthread H and then active H;
+ 		= YYTASKS := insert (get YYTASKS) (I,J;H,SEM,subst 'X);
+ 
+ /* Kill a task. */
+ 
+ yytask (I:Int,J:Int) ()
+ where (H,SEM,'X) = get YYTASKS!(I,J):
+ 		= puts "Task killed\n" || fail;
+ 		= cancel H || YYTASKS := delete (get YYTASKS) (I,J) ||
+ 		  YYSEM := delete (get YYSEM) (thread_no H)
+ 		    if isthread H;
+ 		= YYTASKS := delete (get YYTASKS) (I,J);