[q-lang-cvs] qcalc qcalc.q,1.40,1.41

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-serv21365

Modified Files:
	qcalc.q 
Log Message:
bugfixes, refactoring, comment changes

Index: qcalc.q
===================================================================
RCS file: /cvsroot/q-lang/qcalc/qcalc.q,v
retrieving revision 1.40
retrieving revision 1.41
diff -C2 -d -r1.40 -r1.41
*** qcalc.q	29 Oct 2007 19:36:39 -0000	1.40
--- qcalc.q	29 Oct 2007 20:38:20 -0000	1.41
***************
*** 322,325 ****
--- 322,333 ----
  normal_cursor	= qt "QApplication" "restoreOverrideCursor" ();

+ /* Switch views. */
+ 
+ show_table	= qt TABW "setCurrentPage" 0
+ 		    if qt TABW "currentPageIndex" () = 1;
+ 
+ show_editor	= qt TABW "setCurrentPage" 1
+ 		    if qt TABW "currentPageIndex" () = 0;
+ 
  /* Callbacks. */

***************
*** 444,447 ****
--- 452,457 ----
  else echo '+++ Error.'; fi";

+ /* Compile stuff and start the interpreter. */
+ 
  compile _ _ _	= waitmsg "Compiling..." ||
  		  init_interp ||
***************
*** 505,519 ****
  		= true otherwise;

! def REDIT = ref false, LAST_EDIT = ref ();
! 
! text_changed _ _ _
! 		= EDITED := true || update_title;

! linenumbermsg _ _ N
! 		= statusmsg $ sprintf "Line %d" (N+1);

  eval _ _ (I,J)	= finish_edit true (I,J)
  		    if global and then
! 		      qt TABW "currentPageIndex" () = 0 and then
  		      not get REDIT;

--- 515,525 ----
  		= true otherwise;

! /* Editing table cells and evaluation. */

! def REDIT = ref false, LAST_EDIT = ref ();

  eval _ _ (I,J)	= finish_edit true (I,J)
  		    if global and then
! 		      (qt TABW "currentPageIndex" () = 0) and then
  		      not get REDIT;

***************
*** 525,537 ****
  		    where S = qt TABLE "text" (I,J);

- updatemsg (I,J)	= statusmsg $ sprintf "%s%d = %s" ("A"+J,I+1,S)
- 		    where (S,_,_) = get EVAL!(I,J);
- 		= statusmsg $ sprintf "%s%d" ("A"+J,I+1)
- 		    otherwise;
- 
  edit S D ()
  where I = qt TABLE "currentRow" (), J = qt TABLE "currentColumn" ()
  if global and then not qt TABLE "isEditing" () and then
!   qt TABW "currentPageIndex" () = 0:
  		= LAST_EDIT := (I,J) ||
  		  qt TABLE "setText" (I,J,sprintf "= %s" S) ||
--- 531,538 ----
  		    where S = qt TABLE "text" (I,J);

  edit S D ()
  where I = qt TABLE "currentRow" (), J = qt TABLE "currentColumn" ()
  if global and then not qt TABLE "isEditing" () and then
!   (qt TABW "currentPageIndex" () = 0):
  		= LAST_EDIT := (I,J) ||
  		  qt TABLE "setText" (I,J,sprintf "= %s" S) ||
***************
*** 546,552 ****
  		  qt TABLE "editCell" (I,J)
  		    where (S,_,_) = get EVAL!(I,J)
! 		    if global and then qt TABW "currentPageIndex" () = 0;

! accept _ _ _ if global and then qt TABW "currentPageIndex" () = 0:
  		= EDITED := true || REDIT := true ||
  		  qt TABLE "endEdit" (I,J,true,false) ||
--- 547,553 ----
  		  qt TABLE "editCell" (I,J)
  		    where (S,_,_) = get EVAL!(I,J)
! 		    if global and then (qt TABW "currentPageIndex" () = 0);

! accept _ _ _ if global:
  		= EDITED := true || REDIT := true ||
  		  qt TABLE "endEdit" (I,J,true,false) ||
***************
*** 554,558 ****
  		    where I = qt TABLE "currentRow" (),
  		      J = qt TABLE "currentColumn" ()
! 		    if qt TABLE "isEditing" ();
  		= doprocess (I,J)
  		    if member (get EVAL) (I,J)
--- 555,560 ----
  		    where I = qt TABLE "currentRow" (),
  		      J = qt TABLE "currentColumn" ()
! 		    if qt TABLE "isEditing" () and then
! 		      (qt TABW "currentPageIndex" () = 0);
  		= doprocess (I,J)
  		    if member (get EVAL) (I,J)
***************
*** 561,565 ****
  		    otherwise;

! accept2 S D A if global and then qt TABW "currentPageIndex" () = 0:
  		= accept S D A ||
  		  if qt TABLE "hasFocus" () then
--- 563,567 ----
  		    otherwise;

! accept2 S D A if global and then (qt TABW "currentPageIndex" () = 0):
  		= accept S D A ||
  		  if qt TABLE "hasFocus" () then
***************
*** 580,584 ****
  		      J = qt TABLE "currentColumn" ()
  		    if global and then qt TABLE "isEditing" () and then
! 		      qt TABW "currentPageIndex" () = 0;

  check_editing	= EDITED := true || REDIT := true ||
--- 582,586 ----
  		      J = qt TABLE "currentColumn" ()
  		    if global and then qt TABLE "isEditing" () and then
! 		      (qt TABW "currentPageIndex" () = 0);

  check_editing	= EDITED := true || REDIT := true ||
***************
*** 588,591 ****
--- 590,595 ----
  		= finish_edit false (I,J) if neq () (get LAST_EDIT);

+ /* Various status updates. */
+ 
  activate _ _ (I,J)
  		= updatemsg (I,J)
***************
*** 593,596 ****
--- 597,615 ----
  		      eq () (get LAST_EDIT);

+ updatemsg (I,J)	= statusmsg $ sprintf "%s%d = %s" ("A"+J,I+1,S)
+ 		    where (S,_,_) = get EVAL!(I,J);
+ 		= statusmsg $ sprintf "%s%d" ("A"+J,I+1)
+ 		    otherwise;
+ 
+ /* These are related to the script editor. */
+ 
+ text_changed _ _ _
+ 		= EDITED := true || update_title;
+ 
+ linenumbermsg _ _ N
+ 		= statusmsg $ sprintf "Line %d" (N+1);
+ 
+ /* More script editor operations. */
+ 
  indent _ _ _	= qt EDIT "setSelection" (L,0,L,#R) ||
  		  qt EDIT "insert" T ||
***************
*** 613,620 ****
  		= " " otherwise;

  def REPLS = ref 0;

  find _ _ _ if global:
! 		= find_dg || REPLS := 0 || find_clearmsg;

  find_prev _ _ _ if global:
--- 632,645 ----
  		= " " otherwise;

+ goto_line _ _ _	= qt EDIT "setCursorPosition" (N-1,0) ||
+ 		  qt EDIT "setFocus" ()
+ 		    where (N,_) = qt EDIT "getCursorPosition" (0,0),
+ 		      (N,true) = show_editor || line_dg (N+1),
+ 		      N = min N (qt EDIT "paragraphs" ());
+ 
  def REPLS = ref 0;

  find _ _ _ if global:
! 		= find_dg || REPLS := 0 || find_clearmsg || show_editor;

  find_prev _ _ _ if global:
***************
*** 709,717 ****
  		= qt FIND_STATUS "setText" S;

! show_table	= qt TABW "setCurrentPage" 0
! 		    if qt TABW "currentPageIndex" () = 1;
! 
! show_editor	= qt TABW "setCurrentPage" 1
! 		    if qt TABW "currentPageIndex" () = 0;

  edit_undo _ _ _ if global:
--- 734,738 ----
  		= qt FIND_STATUS "setText" S;

! /* Various editing operations. */

  edit_undo _ _ _ if global:
***************
*** 816,819 ****
--- 837,842 ----
  		= (I,J,S);

+ /* Helper functions for processing selections. */
+ 
  translate (DI,DJ) (I,J,S)
  		= (I+DI,J+DJ,sprintf "= %s" (translate (DI,DJ) S))
***************
*** 907,916 ****
  		= false otherwise;

! goto_line _ _ _	= show_editor ||
! 		  qt EDIT "setCursorPosition" (N-1,0) ||
! 		  qt EDIT "setFocus" ()
! 		    where (N,_) = qt EDIT "getCursorPosition" (0,0),
! 		      (N,true) = line_dg (N+1),
! 		      N = min N (qt EDIT "paragraphs" ());

  get_pointsize W	= PT if PT>=0
--- 930,934 ----
  		= false otherwise;

! /* Font operations. */

  get_pointsize W	= PT if PT>=0
***************
*** 971,974 ****
--- 989,994 ----
  		= enable_highlighting B;

+ /* File operations. */
+ 
  def MAGIC2 = "// Start of script. Please do not remove this line.";

***************
*** 1142,1149 ****
  chksel _	= false otherwise;

! /* Print. Mostly pilfered from the Qt3 docs. */

! // Vertical offset between paragraphs. This is used if both formula and value
! // are printed.
  def PSEP = 2;

--- 1162,1169 ----
  chksel _	= false otherwise;

! /* Print. This is based on the "application walkthrough" from the Qt3 docs. */

! /* Vertical offset between paragraphs. This is used if both formula and value
!    are printed. */
  def PSEP = 2;

***************
*** 1159,1164 ****
  		      WD = qt M "width" ()-2*MARGIN,
  		      HT = qt M "height" ()-2*MARGIN,
! 		      // define a style for the QSimpleRichText with custom
! 		      // vertical paragraph margin
  		      STYLE = qt_new "QStyleSheet" (),
  		      P_ITEM = qt STYLE "item" "p",
--- 1179,1184 ----
  		      WD = qt M "width" ()-2*MARGIN,
  		      HT = qt M "height" ()-2*MARGIN,
! 		      /* Define a style for the QSimpleRichText with custom
! 			 vertical paragraph margin. */
  		      STYLE = qt_new "QStyleSheet" (),
  		      P_ITEM = qt STYLE "item" "p",
***************
*** 1259,1262 ****
--- 1279,1284 ----
  		  where L = map htmlquote $ filter (neg null) [S,F];

+ /* Exit the application. */
+ 
  bail_out _ _ _	= qt APP "exit" 1
  		    if check_editing || check_edited if global;
***************
*** 1768,1771 ****
--- 1790,1795 ----
  		= S;

+ /* Process cell values after edits or after loading a new file. */
+ 
  process_all	= begin_compute ||
  		  do flag U || compute_all V ||
***************
*** 1879,1882 ****
--- 1903,1909 ----
  /* Inferior Q process. *****************************************************/

+ /* FIXME: This currently uses forkpty, which is convenient but Unix-only. We
+    should use something more portable like BSD sockets for IPC here. */
+ 
  termattr FD	= tcsetattr FD TCSAFLUSH ATTR
  		    where ATTR = tcgetattr FD,
***************
*** 1904,1909 ****
  		= S;

! // Suppress messages concerning lines not in the user script, and replace the
! // temporary filename with the "anonymous" name.
  def TMPNAME = ref "";
  format_script S	= if FNAME<>get TMPNAME then S
--- 1931,1937 ----
  		= S;

! /* Suppress messages concerning lines not in the user script, and replace the
!    temporary filename with the "anonymous" name. */
! 
  def TMPNAME = ref "";
  format_script S	= if FNAME<>get TMPNAME then S
***************
*** 1929,1932 ****
--- 1957,1965 ----
  		= S otherwise;

+ /* KLUDGE: This does some cleanup of compiler messages referring to lines not
+    in the user script. We have to do this to catch some errors which are
+    really in the user part of the script, but are caught only at the beginning
+    of the generated part of the script. */
+ 
  munge_compiler_msg N MSG
  		= MSG
***************
*** 1936,1939 ****
--- 1969,1975 ----
  		= MSG otherwise;

+ /* The reader thread processes messages received from the inferior Q
+    process. */
+ 
  post_msg S	= catch () (post MSGS (format S));

***************
*** 1949,1956 ****
--- 1985,1999 ----
  		= () otherwise;

+ /* Set up a pipe to the interpreter. Returns a triple (H,PID,MASTER) where H
+    is the handle of the reader thread, PID the process id of the interpreter
+    and MASTER the file descriptor used to exchange data with the inferior
+    process. */
+ 
  task TMP CMD	= TMPNAME := TMP || sleep 0.1 || (H,PID,MASTER)
  		    where (PID,MASTER) = pty CMD,
  		      H = thread (reader MASTER);

+ /* Terminate the given interpreter process and perform cleanup. */
+ 
  fini (H,PID,MASTER)
  		= close MASTER || kill SIGTERM PID || waitpid PID 0 ||