home *** CD-ROM | disk | FTP | other *** search
/ Il CD di internet / CD.iso / SOURCE / D / CLISP / CLISPSRC.TAR / clisp-1995-01-01 / src / windows.d < prev    next >
Encoding:
Text File  |  1994-09-22  |  12.8 KB  |  409 lines
  1. # Stuff for MS-Windows 3.1
  2. # Bruno Haible 22.9.1994
  3.  
  4. #include "lispbibl.c"
  5.  
  6. # Any Windows program needs this:
  7. #define _STDDEF_H_INCLUDED  # WATCOM: avoid clash because of offsetof()
  8. #define _STDDEF_H           # EMX: avoid warning because of offsetof()
  9. #define BYTE WINDOWS_BYTE
  10. #define WORD WINDOWS_WORD
  11. #define INCLUDE_SHELLAPI_H  # include <shellapi.h> for drag&drop support
  12. #include <windows.h>
  13. #undef WORD
  14. #undef BYTE
  15.  
  16. # Some useful definitions:
  17. # define min(x,y)  ((x) < (y) ? (x) : (y))
  18. # define max(x,y)  ((x) > (y) ? (x) : (y))
  19. struct xy { int x; int y; };
  20.  
  21. # A couple of magic identifiers used to access the elements of the resource:
  22. #include "clispwin.h"
  23.  
  24. # Debugging support:
  25. /* #define WIN_DEBUG */
  26. #ifdef WIN_DEBUG
  27.   #define WINDEBUG(x) x
  28.   local void event_out (const char * caller, HWND hWnd, mywindow w, UINT message, WPARAM wParam, LPARAM lParam);
  29. #else
  30.   #define WINDEBUG(x)
  31. #endif
  32.  
  33.  
  34. # Accessing the "command line":
  35. # There is no such thing. (Well, the RSXWIN startup code saves something as
  36. # __argc and __argv, but I don't know what it is.)
  37. # We load the arguments from a file called CLISPWIN.INI, in the Windows
  38. # directory.
  39. #
  40. # Its layout is roughly like this:
  41. #   [CLISP]
  42. #   Arglist="[the command line arguments]"
  43. #   Language="english"
  44. #   Lines=25
  45. #   Columns=80
  46. #   Font="Fixedsys"
  47. #   Fontsize=16
  48. #   Leading=-1
  49. # Fonts should be fixed width (such as "Courier New", "Fixedsys",
  50. # or "Lucinda Sans Typewriter").
  51. # Font sizes should be in the 10..20 point range.
  52. # Leading specifies an adjustment for inter-line spacing.
  53.  
  54. #define ini_filename  "CLISPWIN.INI"
  55. #define ini_section   "CLISP"
  56.  
  57. # Retrieve the value of a "ini file environment variable".
  58. local char* getenv_ini_string (char* name);
  59. local int getenv_ini_int (char* name);
  60. local char* getenv_ini_string(name)
  61.   var char* name;
  62.   { var uintL bufsize = 50;
  63.     var char* buf;
  64.     while (1)
  65.       { buf = malloc(bufsize);
  66.         if (!buf) return NULL;
  67.         if (GetPrivateProfileString(ini_section, name, "",
  68.                                     buf, bufsize,
  69.                                     ini_filename
  70.                                    )
  71.             < bufsize-1
  72.            )
  73.           return buf;
  74.         free(buf);
  75.         bufsize *= 2; # retry with larger buffer
  76.       }
  77.   }
  78. local int getenv_ini_int(name)
  79.   var char* name;
  80.   { return GetPrivateProfileInt(ini_section, name, 0,
  81.                                 ini_filename
  82.                                );
  83.   }
  84.  
  85.  
  86. # The program's "instance" and "command line".
  87. local HINSTANCE global_hInstance;
  88. local LPSTR global_lpszCmdLine;
  89.  
  90. # Our (modified) command line arguments.
  91. local char* * argv;
  92. local int argc;
  93.  
  94. # Get the command line args, maybe from the ini file.
  95. local void extend_args (void);
  96. local void extend_args()
  97.   { local var char* dummy_argv[] = { "CLISPWIN" };
  98.     var char* arglist;
  99.     argv = dummy_argv; argc = 1;
  100.     if (!(global_lpszCmdLine[0]=='\0'))
  101.       # If args have been given, they override the INI file args.
  102.       { begin_system_call();
  103.         arglist = malloc(strlen(global_lpszCmdLine)+1);
  104.         end_system_call();
  105.         if (!arglist) return;
  106.         strcpy(arglist,global_lpszCmdLine);
  107.       }
  108.       else
  109.       { begin_system_call();
  110.         arglist = getenv_ini_string("Arglist");
  111.         end_system_call();
  112.         if (!arglist) return;
  113.       }
  114.     # Split up into arguments, separated by whitespace:
  115.     #define whitespacep(c)  (((c)==' ') || ((c)=='\t') || ((c)=='\n'))
  116.     { var char* ptr = arglist;
  117.       var uintC count = 0;
  118.       loop
  119.         { if (*ptr=='\0') break;
  120.           if (whitespacep(*ptr))
  121.             { ptr++; }
  122.             else
  123.             { count++;
  124.               until ((*ptr=='\0') || whitespacep(*ptr))
  125.                 { ptr++; }
  126.             }
  127.         }
  128.       if (count==0)
  129.         return; # no new arguments
  130.       begin_system_call();
  131.      {var int new_argc = 1 + count;
  132.       var char* * new_argv = malloc(new_argc*sizeof(char*));
  133.       end_system_call();
  134.       if (!new_argv) return;
  135.       new_argv[0] = argv[0]; count = 1;
  136.       ptr = arglist;
  137.       loop
  138.         { if (*ptr=='\0') break;
  139.           if (whitespacep(*ptr))
  140.             { ptr++; }
  141.             else
  142.             { new_argv[count] = ptr;
  143.               until ((*ptr=='\0') || whitespacep(*ptr))
  144.                 { ptr++; }
  145.               if (*ptr=='\0') break;
  146.               *ptr = '\0';
  147.               ptr++;
  148.               count++;
  149.             }
  150.         }
  151.       argc = new_argc; argv = new_argv;
  152.     }}
  153.     #undef whitespacep
  154.   }
  155.  
  156.  
  157. # The type of our event handler functions:
  158. typedef long (*eventhandler) (mywindow w, UINT message, WPARAM wParam, LPARAM lParam);
  159.  
  160. # The type of our events:
  161. typedef enum { ev_key, ev_menu, ev_drop, ev_paste, ev_eof } event_type;
  162. typedef struct event { event_type type;
  163.                        union { cint key; WPARAM wParam; char* pastebuf; } u;
  164.                      }
  165.         event;
  166.  
  167. # The type of our windows:
  168. struct mywindow
  169.        { HWND hWnd; # its MS-Windows handle
  170.          boolean in_focus; # whether this window holds the focus
  171.          boolean for_output; # whether this window is an output stream
  172.                              # or only presents static text
  173.          boolean for_input; # whether this window is an input stream
  174.                             # or only presents output
  175.          # a list of event handlers, most specific first
  176.          eventhandler eventhandler1, eventhandler2, eventhandler3, eventhandler4;
  177.          # data for text windows:
  178.          struct {
  179.                   int width;  # text width, in characters
  180.                   int height; # text height, in characters
  181.                   # The text displayed in the window:
  182.                   char* * contents; # an array of length height,
  183.                                     # each of length width
  184.                   # User feedback during Cut&Paste operation:
  185.                   # Some of the text may be selected, inverted on the screen.
  186.                   struct xy selpoint1, selpoint2;
  187.                   enum { none, # nothing selected, selpoint1/2 invalid
  188.                          notmoved, # one mouse click, no move, selpoint1 = selpoint2
  189.                          marking, # mouse is moving
  190.                          marked # selection done
  191.                        }
  192.                        in_marking;
  193.          # data for text windows which support output:
  194.                   # To focus the user's attention, we place a text cursor at
  195.                   # a point we call the "current line/column".
  196.                   struct xy cursor;
  197.                   boolean cursor_visible; # is the cursor currently visible?
  198.                 }
  199.                 text;
  200.          # data for windows which support input:
  201.          struct { # keyboard typeahead buffer, event queue
  202.                   event* ev_fifo;
  203.                   uintL ev_fifo_size;
  204.                   event* ev_fifo_out;
  205.                   event* ev_fifo_in;
  206.                   # The current state of a finite state machine:
  207.                   boolean in_paste; # getting our input from a paste buffer
  208.                   event paste_ev; # the current paste event
  209.                   char* paste_ptr; # pointer into the paste buffer
  210.                 }
  211.                 input;
  212.          # data for text windows which support input:
  213.          struct {
  214.                   char* line;      # current line
  215.                   uintL line_size; # its malloc() size
  216.                   uintL count;     # number of characters in the line
  217.                   uintL index;     # number of characters already consumed
  218.                 }
  219.                 textinput;
  220.          # linked list of windows:
  221.          struct mywindow * next;
  222.        };
  223.  
  224.  
  225. # This is the list of all windows we are managing.
  226. local mywindow all_windows = NULL;
  227.  
  228. # Add a window to the list all_windows:
  229. local void register_window (mywindow w);
  230. local void register_window(w)
  231.   var mywindow w;
  232.   { w->next = all_windows; all_windows = w; }
  233. # The converse:
  234. local void unregister_window (mywindow w);
  235. local void unregister_window(w)
  236.   var mywindow w;
  237.   { var mywindow * p = &all_windows;
  238.     until (*p == NULL) if (*p == w) { *p = w->next; return; }
  239.   }
  240.  
  241. # Lookup a window, given its handle:
  242. local mywindow find_window (HWND hWnd);
  243. local mywindow find_window(hWnd)
  244.   var HWND hWnd;
  245.   { var mywindow w;
  246.     for (w = all_windows; !(w==NULL); w = w->next)
  247.       { if (w->hWnd == hWnd)
  248.           { return w; }
  249.       }
  250.     # If hWnd wasn't found, it belongs to a window that is being created.
  251.     return NULL;
  252.   }
  253.  
  254. # The event handler for the whole application, see below.
  255. local long _export FAR PASCAL all_event (HWND hWnd, UINT message, WPARAM wParam, LPARAM lParam);
  256.  
  257. # The default event handler, see below.
  258. local long default_event (mywindow w, UINT message, WPARAM wParam, LPARAM lParam);
  259.  
  260.  
  261. # A library for text windows:
  262.  
  263. #include "wintext.c"
  264.  
  265.  
  266. # A status window:
  267.  
  268. #include "winstat.c"
  269.  
  270.  
  271. # The main window:
  272.  
  273. #include "winmain.c"
  274.  
  275.  
  276. # A default event handler:
  277. local long default_event (w,message,wParam,lParam)
  278.   var mywindow w;
  279.   var UINT message;
  280.   var WPARAM wParam;
  281.   var LPARAM lParam;
  282.   { switch (message)
  283.       { case WM_SETFOCUS:
  284.           in_focus = TRUE;
  285.           show_mouse_cursor();
  286.           break;
  287.         case WM_KILLFOCUS:
  288.           in_focus = FALSE;
  289.           break;
  290.         default:
  291.           break;
  292.       }
  293.     return DefWindowProc(w->hWnd,message,wParam,lParam);
  294.   }
  295.  
  296. # The event handler for the whole application.
  297. local long _export FAR PASCAL all_event(hWnd,message,wParam,lParam)
  298.   var HWND hWnd;
  299.   var UINT message;
  300.   var WPARAM wParam;
  301.   var LPARAM lParam;
  302.   { var mywindow w = find_window(hWnd);
  303.     WINDEBUG( event_out("all_event",hWnd,w,message,wParam,lParam); )
  304.     if (w)
  305.       return w->eventhandler1(w,message,wParam,lParam);
  306.     # If hWnd wasn't found, it belongs to a window that is being created.
  307.     # We haven't yet had a chance to call register_window().
  308.     return DefWindowProc(hWnd,message,wParam,lParam);
  309.   }
  310.  
  311.  
  312. # This is the main program, called by Windows.
  313. # You may also call it the application's INITIALIZE-INSTANCE method.
  314. global int PASCAL WinMain (HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpszCmdLine, int nCmdShow);
  315. extern int main (int argc, char* argv[]);
  316. global int PASCAL WinMain(hInstance,hPrevInstance,lpszCmdLine,nCmdShow)
  317.   var HINSTANCE hInstance;
  318.   var HINSTANCE hPrevInstance;
  319.   var LPSTR lpszCmdLine;
  320.   var int nCmdShow;
  321.   { var int retval;
  322.  
  323.     #ifdef EMUNIX
  324.       # Initialize SP_start so that begin_system_call() will work.
  325.       # SP() = %esp = 0x0000FE38 here.
  326.       SP_start = (void*)(SP() - 0x4000);
  327.       # This is preliminary:
  328.       # The system stack is 16 KB below the normal stack, for now.
  329.     #endif
  330.  
  331.     global_hInstance = hInstance;
  332.     global_lpszCmdLine = lpszCmdLine;
  333.     # hPrevInstance will be NULL since we have only one thread running.
  334.  
  335.     # Look up the INI environment.
  336.     extend_args();
  337.  
  338.     # Mouse cursors.
  339.     init_cursors();
  340.     in_focus = FALSE; in_wait = FALSE; in_gc = FALSE; mouse_hidden = FALSE;
  341.  
  342.     # Load accelerator table.
  343.     begin_system_call();
  344.     hAccel = LoadAccelerators(global_hInstance,"ACCELERATORS_1");
  345.     end_system_call();
  346.  
  347.     if (!init_text_class())
  348.       return FALSE;
  349.  
  350.     # Determine character sizes and colours.
  351.     get_char_info();
  352.  
  353.     # Main window.
  354.     { var int main_width, main_height;
  355.       begin_system_call();
  356.       main_width = getenv_ini_int("Columns");
  357.       if (!main_width) { main_width = 80; }
  358.       main_height = getenv_ini_int("Lines");
  359.       if (!main_height) { main_height = 25; }
  360.       end_system_call();
  361.       if (!main_create(main_width,main_height))
  362.         return FALSE;
  363.     }
  364.  
  365.     # Status window.
  366.     status_create(main_window->hWnd);
  367.  
  368.     # Display the main window.
  369.     begin_system_call();
  370.     ShowWindow(main_window->hWnd,nCmdShow);
  371.     UpdateWindow(main_window->hWnd);
  372.     end_system_call();
  373.  
  374.     # Go, CLISP, go!
  375.     retval = main(argc,argv);
  376.  
  377.     begin_system_call();
  378.     DestroyWindow(main_window->hWnd);
  379.     end_system_call();
  380.  
  381.     return retval;
  382.   }
  383.  
  384.  
  385. # Other auxiliary functions:
  386.  
  387. #include "winaux.c"
  388.  
  389.  
  390. # TODO:
  391. # Fix Cut&Paste. It does not work yet.
  392. # ANSI to OEM and back?!?!? This is a mess:
  393. #   - files may be in ISO or DOS character set. What do we assume?
  394. #   - Type Alt-128 at the keyboard, get C-cedilla, which has code 199.
  395. #     The up-/downcase tables in io.d do not correctly downcase this.
  396. #   - The mode of a font can be enquired using GetTextMetrics.
  397. # Support for several/switchable font.
  398. # ev_eof shall terminate the application. Currently (sys::%exit) is the only way.
  399. # Endless loop WM_QUIT -> end_of_main -> WM_DESTROY -> WM_QUIT ...
  400. # About and Copyright boxes are too large, choose help text or something else.
  401. # Update status_window more regularly, use interruptp() macro for this.
  402. # Define an "interrupt event" which is acknowledged by interruptp().
  403. # Mouse click into the line during winterm_readchar shall position the cursor.
  404. # Menu points for LOAD, DRIBBLE, STEP, ABORT, CONTINUE and many more.
  405. # CLOSE rectangle for the status window.
  406. # SCREEN::MAKE-WINDOW crashes.
  407. # Translate the menu into 3 languages, choose it at runtime.
  408.  
  409.