[q-lang-cvs] qcalc qcalc.q,1.138,1.139

SourceForge Headquarters 1320 Columbia Street Suite 310 San Diego, CA 92101 +1 (858) 422-6466

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

Modified Files:
	qcalc.q 
Log Message:
bugfixes

Index: qcalc.q
===================================================================
RCS file: /cvsroot/q-lang/qcalc/qcalc.q,v
retrieving revision 1.138
retrieving revision 1.139
diff -C2 -d -r1.138 -r1.139
*** qcalc.q	13 Nov 2007 04:44:21 -0000	1.138
--- qcalc.q	13 Nov 2007 09:37:08 -0000	1.139
***************
*** 345,349 ****
  		= false otherwise;

! unquote S	= (X,X) if checkstr 'X where 'X = valq S;
  		= (S,fformat S) otherwise;

--- 345,349 ----
  		= false otherwise;

! unquote S	= ((),X) if checkstr 'X where 'X = valq S;
  		= (S,fformat S) otherwise;

***************
*** 410,417 ****

  insert_elem D X	= insert D (X,true) if not member D X;
  		= D otherwise;

- set_cells Xs:HDict
- 		= CELLS := Xs;
  insert_cells ((I,J),X)
  		= CELLS := insert (get CELLS) ((I,J),X);
--- 410,420 ----

  insert_elem D X	= insert D (X,true) if not member D X;
+ 		= insert D (X,true) if is_nil Y where Y:QtObject = D!X;
+ 		= D otherwise;
+ 
+ delete_elem D X	= delete D X where true = D!X;
+ 		= delete D X if is_nil Y where Y:QtObject = D!X;
  		= D otherwise;

  insert_cells ((I,J),X)
  		= CELLS := insert (get CELLS) ((I,J),X);
***************
*** 419,432 ****
  		= CELLS := insert_elem (get CELLS) (I,J);
  insert_cells Xs:List
! 		= CELLS := foldl insert (get CELLS) Xs;
  delete_cells (I,J)
! 		= CELLS := delete (get CELLS) (I,J);
  delete_cells Xs:List
! 		= CELLS := foldl delete (get CELLS) Xs;
  filter_cells P	= CELLS := hdict $ filter P $ list $ get CELLS;

- set_eval Xs:HDict
- 		= EVAL := Xs || make_xref if null (get EVAL);
- 		= update_xref (delta (get EVAL) Xs) || EVAL := Xs otherwise;
  insert_eval ((I,J),X)
  		= update_xref ((I,J),X) ||
--- 422,432 ----
  		= CELLS := insert_elem (get CELLS) (I,J);
  insert_cells Xs:List
! 		= CELLS := foldl insert_elem (get CELLS) Xs;
  delete_cells (I,J)
! 		= CELLS := delete_elem (get CELLS) (I,J);
  delete_cells Xs:List
! 		= CELLS := foldl delete_elem (get CELLS) Xs;
  filter_cells P	= CELLS := hdict $ filter P $ list $ get CELLS;

  insert_eval ((I,J),X)
  		= update_xref ((I,J),X) ||
***************
*** 448,464 ****
  		      E = zip K $ map (sort indexcmp.map (K!)) E;

- delta OLD_EVAL NEW_EVAL
- 		= OLD++NEW
- 		    where OLD = sort cellcmp (list OLD_EVAL),
- 		      NEW = sort cellcmp (list NEW_EVAL),
- 		      OLD = filter (deltacmp NEW_EVAL) OLD,
- 		      NEW = filter (deltacmp OLD_EVAL) NEW,
- 		      OLD = filter (neg $ member (hdict NEW).fst) OLD,
- 		      OLD = map fst OLD;
- 
- deltacmp D (I,J;_,_,X)
- 		= (X<>Y) where (_,_,Y) = D!(I,J);
- 		= true otherwise;
- 
  update_xref (I,J;_,_,NEW_DEPS)
  		= //printf "XREF += %s\n" $ str E ||
--- 448,451 ----
***************
*** 797,803 ****
  		= gui_setval X S || get CELLS!(I,J)
  		    where X:QtObject = gui_elem (I,J);
! 		= if null S0 then delete_cells (I,J)
! 		  else cell_setval (I,J) S0 || S0
! 		    where (S0,S1) = unquote S;

  // a variation of the above, used in the evaluation loop (collect_results)
--- 784,791 ----
  		= gui_setval X S || get CELLS!(I,J)
  		    where X:QtObject = gui_elem (I,J);
! 		= if null S1 then delete_cells (I,J) ||
! 		  cell_setval (I,J) S0 || S
! 		    where (S0,S1) = unquote S,
! 		      S = if isstr S0 then S else S1;

  // a variation of the above, used in the evaluation loop (collect_results)
***************
*** 806,813 ****
  		= gui_setval X S || get CELLS!(I,J)
  		    where X:QtObject = gui_elem (I,J);
! 		= if null S0 then delete_cells (I,J)
! 		  else cell_setval (I,J) S0 ||
! 		  clear_cell (I,J) || set_cell (I,J) S || S0
! 		    where (S0,S1) = unquote S;

  def TEMPL = "%s\nimport calclib;\n/* Main program generated by QCalc. */\n",
--- 794,802 ----
  		= gui_setval X S || get CELLS!(I,J)
  		    where X:QtObject = gui_elem (I,J);
! 		= if null S1 then delete_cells (I,J) ||
! 		  cell_setval (I,J) S0 ||
! 		  clear_cell (I,J) || set_cell (I,J) S1 || S
! 		    where (S0,S1) = unquote S,
! 		      S = if isstr S0 then S else S1;

  def TEMPL = "%s\nimport calclib;\n/* Main program generated by QCalc. */\n",
***************
*** 1042,1046 ****

  has_table_item (I,J)
! 		= true if not is_nil IT where IT:QtObject = get CELLS!(I,J);
  		= false otherwise;

--- 1031,1038 ----

  has_table_item (I,J)
! 		= true
! 		    where (_,_,_|_) = qt_data IT
! 		    if not is_nil IT
! 		    where IT:QtObject = qt TABLE "item" (I,J);
  		= false otherwise;

***************
*** 1066,1075 ****
  if (I,J) = real_index (I,J):
  		= qt TABLE "clearCell" (I,J) if not has_table_item (I,J);
! 		= qt TABLE "clearCell" (I,J) ||
! 		  spanned_table_item (I,J) (N,M)
  		    if (N>1) or else (M>1)
  		    where (N,M) = cell_span (I,J);
! 		= qt TABLE "clearCell" (I,J) ||
! 		  get_table_item (I,J)
  		    otherwise;

--- 1058,1071 ----
  if (I,J) = real_index (I,J):
  		= qt TABLE "clearCell" (I,J) if not has_table_item (I,J);
! 		= cell_setval (I,J) Y
! 		    where Y = cell_getval (I,J),
! 		      IT = qt TABLE "clearCell" (I,J) ||
! 		      spanned_table_item (I,J) (N,M)
  		    if (N>1) or else (M>1)
  		    where (N,M) = cell_span (I,J);
! 		= cell_setval (I,J) Y
! 		    where Y = cell_getval (I,J),
! 		      IT = qt TABLE "clearCell" (I,J) ||
! 		      get_table_item (I,J)
  		    otherwise;

***************
*** 1356,1361 ****

  edit_undo _ _ _ if is_global:
! 		= undo || updatemsg (I,J)
! 		    where (I,J) = current_cell
  		    where _ = check_editing
  		    if qt TABW "currentPageIndex" () = 0;
--- 1352,1356 ----

  edit_undo _ _ _ if is_global:
! 		= undo || updatemsg current_cell
  		    where _ = check_editing
  		    if qt TABW "currentPageIndex" () = 0;
***************
*** 1364,1369 ****

  edit_redo _ _ _ if is_global:
! 		= redo || updatemsg (I,J)
! 		    where (I,J) = current_cell
  		    where _ = check_editing
  		    if qt TABW "currentPageIndex" () = 0;
--- 1359,1363 ----

  edit_redo _ _ _ if is_global:
! 		= redo || updatemsg current_cell
  		    where _ = check_editing
  		    if qt TABW "currentPageIndex" () = 0;
***************
*** 1546,1550 ****
  		    where SEL:List = check_editing || get_clipboard true,
  		      [(I1,J1,_)|_] = SEL,
! 		      (I,J) = current_cell,
  		      (DI,DJ) = (I-I1,J-J1),
  		      SEL = map (translate (DI,DJ)) SEL,
--- 1540,1544 ----
  		    where SEL:List = check_editing || get_clipboard true,
  		      [(I1,J1,_)|_] = SEL,
! 		      (I,J) = real_current_cell,
  		      (DI,DJ) = (I-I1,J-J1),
  		      SEL = map (translate (DI,DJ)) SEL,
***************
*** 1564,1568 ****
  		    where SEL:List = check_editing || get_clipboard false,
  		      [(I1,J1,_)|_] = SEL,
! 		      (I,J) = current_cell,
  		      (DI,DJ) = (I-I1,J-J1),
  		      SEL = map (translate (DI,DJ)) SEL,
--- 1558,1562 ----
  		    where SEL:List = check_editing || get_clipboard false,
  		      [(I1,J1,_)|_] = SEL,
! 		      (I,J) = real_current_cell,
  		      (DI,DJ) = (I-I1,J-J1),
  		      SEL = map (translate (DI,DJ)) SEL,
***************
*** 3182,3186 ****

  update_cell (I,J) S
! 		= () if is_gui_elem (I,J);
  		= cell_setval (I,J) S ||
  		  set_cell (I,J) (fformat S) ||
--- 3176,3180 ----

  update_cell (I,J) S
! 		= cell_setval (I,J) () if is_gui_elem (I,J);
  		= cell_setval (I,J) S ||
  		  set_cell (I,J) (fformat S) ||
***************
*** 3218,3222 ****
  		    if check_interp;

! doprocess (I,J)	= insert_cells (I,J) || clear_cell (I,J) ||
  		  // do the necessary reevaluations
  		  if check_interp then compute V
--- 3212,3217 ----
  		    if check_interp;

! doprocess (I,J)	= insert_cells (I,J) ||
! 		  cell_setval (I,J) () || clear_cell (I,J) ||
  		  // do the necessary reevaluations
  		  if check_interp then compute V
***************
*** 3231,3234 ****
--- 3226,3230 ----
  clear (I,J)	= if is_empty (I,J) then delete_cells (I,J)
  		  else insert_cells (I,J) ||
+ 		  cell_setval (I,J) () ||
  		  clear_cell (I,J) || set_cell (I,J) S ||
  		  if check_interp then compute V
***************
*** 3246,3293 ****
  		      X = gui_getval X;

! process1 (CELLS,EVAL) (I,J,S)
! 		= clear_cell (I,J) || (CELLS,EVAL)
  		    where ("=",S) = (hd S,trim (tl S)),
! 		      'X = parse S, DEPS = deps 'X,
! 		      (CELLS,EVAL) =
! 		      (insert_elem CELLS (I,J),insert EVAL (I,J;S,'X,DEPS));
! 		= clear_cell (I,J) || set_cell (I,J) S || (CELLS,EVAL)
! 		    where (CELLS,EVAL) =
! 		      (insert_elem CELLS (I,J),delete EVAL (I,J))
  		    if not null S;
! 		= clear_cell (I,J) || (CELLS,EVAL)
! 		    where (CELLS,EVAL) =
! 		      (delete CELLS (I,J),delete EVAL (I,J))
  		    otherwise;

  process_sel W	= if check_interp then compute V
! 		    where (C,E) = foldl process1 (get CELLS,get EVAL) W,
! 		      _ = set_cells C || set_eval E,
  		      W = map (flip (flip sub 0) 1) W,
  		      V = eval_list (cst true) W
  		    if not null W and then check_interp;

! process2 (CELLS,EVAL) (I,J,S)
! 		= (CELLS,EVAL) if is_qt_object S;
! 		= clear_cell (I,J) || (CELLS,EVAL)
  		    where ("=",S) = (hd S,trim (tl S)),
! 		      'X = parse S, DEPS = deps 'X,
! 		      (CELLS,EVAL) =
! 		      (insert_elem CELLS (I,J),insert EVAL (I,J;S,'X,DEPS));
! 		= clear_cell (I,J) || set_cell (I,J) S1 || (CELLS,EVAL)
! 		    where S0 = CELLS!(I,J),
! 		      (S0,S1) = if isstr S0 then unquote S else (true,S),
! 		      (CELLS,EVAL) =
! 			(insert CELLS ((I,J),S0),delete EVAL (I,J))
  		    if not null S;
! 		= clear_cell (I,J) || (CELLS,EVAL)
! 		    where (CELLS,EVAL) =
! 		      (delete CELLS (I,J),delete EVAL (I,J))
  		    otherwise;

  process_sel2 W	= if check_interp then compute V
  		    where //_ = printf "*** pending updates: %s\n" $ str W,
! 		      (C,E) = foldl process2 (get CELLS,get EVAL) W,
! 		      _ = set_cells C || set_eval E,
  		      W = map (flip (flip sub 0) 1) W,
  		      // Exclude all toplevel GUI elements from this list
--- 3242,3287 ----
  		      X = gui_getval X;

! process1 (I,J,S)
! 		= clear_cell (I,J) ||
! 		  insert_cells (I,J) || insert_eval (I,J;S,'X,DEPS) ||
! 		  cell_setval (I,J) ()
  		    where ("=",S) = (hd S,trim (tl S)),
! 		      'X = parse S, DEPS = deps 'X;
! 		= clear_cell (I,J) || set_cell (I,J) S ||
! 		  insert_cells (I,J) || delete_eval (I,J) ||
! 		  cell_setval (I,J) ()
  		    if not null S;
! 		= clear_cell (I,J) ||
! 		  delete_cells (I,J) || delete_eval (I,J) ||
! 		  cell_setval (I,J) ()
  		    otherwise;

  process_sel W	= if check_interp then compute V
! 		    where _ = do process1 W,
  		      W = map (flip (flip sub 0) 1) W,
  		      V = eval_list (cst true) W
  		    if not null W and then check_interp;

! process2 (I,J,S)
! 		= cell_setval (I,J) () if is_qt_object S;
! 		= clear_cell (I,J) ||
! 		  insert_cells (I,J) || insert_eval (I,J;S,'X,DEPS) ||
! 		  cell_setval (I,J) ()
  		    where ("=",S) = (hd S,trim (tl S)),
! 		      'X = parse S, DEPS = deps 'X;
! 		= clear_cell (I,J) || set_cell (I,J) S1 ||
! 		  cell_setval (I,J) S0 ||
! 		  insert_cells (I,J) || delete_eval (I,J)
! 		    where S0 = cell_getval (I,J),
! 		      (S0,S1) = if isstr S0 then unquote S else ((),S)
  		    if not null S;
! 		= clear_cell (I,J) ||
! 		  delete_cells (I,J) || delete_eval (I,J) ||
! 		  cell_setval (I,J) ()
  		    otherwise;

  process_sel2 W	= if check_interp then compute V
  		    where //_ = printf "*** pending updates: %s\n" $ str W,
! 		      _ = do process2 W,
  		      W = map (flip (flip sub 0) 1) W,
  		      // Exclude all toplevel GUI elements from this list
***************
*** 3296,3300 ****
  		    if not null W and then check_interp;

! clear_sel W	= do clear_cell W || compute V
  		    where _ = delete_cells W || delete_eval W,
  		      V = eval_list (cst true) W
--- 3290,3294 ----
  		    if not null W and then check_interp;

! clear_sel W	= do (flip cell_setval ()) W || do clear_cell W || compute V
  		    where _ = delete_cells W || delete_eval W,
  		      V = eval_list (cst true) W