home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / modula-3 / m3-3.5 / m3-3 / usr / local / modula3-3.5.4-B / lib / elisp / m3process.el < prev    next >
Encoding:
Text File  |  1995-11-24  |  11.6 KB  |  393 lines

  1. ; This file is part of m3ide, a simple development environment for M3    
  2. ; Copyright (C) 1995 Michel Dagenais                                     
  3. ;                                                                        
  4. ; This library is free software; you can redistribute it and/or          
  5. ; modify it under the terms of the GNU Library General Public            
  6. ; License as published by the Free Software Foundation; either           
  7. ; version 2 of the License, or (at your option) any later version.       
  8. ;                                                                        
  9. ; This library is distributed in the hope that it will be useful,        
  10. ; but WITHOUT ANY WARRANTY; without even the implied warranty of         
  11. ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU      
  12. ; Library General Public License for more details.                       
  13. ;                                                                        
  14. ; You should have received a copy of the GNU Library General Public      
  15. ; License along with this library; if not, write to the Free             
  16. ; Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.     
  17. ;                                                                        
  18. ; For more information on this program, contact Michel Dagenais at       
  19. ; dagenais@vlsi.polymtl.ca or Electrical Eng. Dept., Ecole Polytechnique 
  20. ; P.O. Box 6079, Station A, Montreal, Quebec, Canada, H3C 3A7.           
  21.  
  22. ;
  23. ; An asynchronous process is started to handle the ide commands.
  24. ; For each command, the command name and the textual arguments are sent.
  25. ; The result is received in a buffer.
  26. ;
  27.  
  28. (provide 'm3process)
  29.  
  30. (defun m3-ide-command (name output-buffer arglist)
  31.   "This function receives the command name, the name of the buffer
  32.   receiving the output and a list of textual arguments"
  33.  
  34.   (let ((tmplist arglist)
  35.        )
  36.  
  37.     (wait-m3-ide-process-busy)
  38.     (prepare-m3-buffers (get-buffer-create output-buffer)
  39.       (get-tmpbuf-create-m3 "*m3-error*")
  40.     )
  41.  
  42.     ; start the obliq process if not already started and lock it.
  43.     (start-m3-ide)
  44.     (set-process-filter m3-ide-process 'receive-m3-ide-result)
  45.     ;(sit-for 0.001)
  46.     (process-send-string m3-ide-process (concat name "\n"))
  47.     (while tmplist
  48.       (process-send-string m3-ide-process 
  49.         (concat (int-to-string (length (car tmplist))) "\n")
  50.       )
  51.       (process-send-string m3-ide-process (car tmplist))
  52.       (setq tmplist (cdr tmplist))
  53.     )
  54.  
  55.     ; a few newline insure that everything is sent. There does not
  56.     ; seem to be a flush available for stuff sent to processes.
  57.     (process-send-string m3-ide-process "\n\n\n\n\n")
  58.     (wait-m3-ide-reply)
  59.     (set-process-filter m3-ide-process ())
  60.   )
  61. )
  62.  
  63. (defun wait-m3-ide-reply ()
  64.   "Wait until the filter sets m3-ide-busy to nil indicating that all the
  65.    expected output was received."
  66.   (while m3-ide-process-busy 
  67.     (progn 
  68.       (message "Receiving Modula-3 Ide result...")
  69.       (sit-for 0.2)
  70.     )
  71.   )
  72. )
  73.  
  74.  
  75. (defun clean-m3-ide-process () (interactive)
  76.   "Kill the current m3-ide process and clear the associated variables."
  77.   (if m3-ide-process 
  78.     (set-process-filter m3-ide-process ())
  79.     (delete-process m3-ide-process)
  80.   )
  81.   (setq m3-ide-process ())
  82.   (setq m3-ide-process-busy ())
  83. )
  84.  
  85. ;
  86. ; A number of global variables are used internally
  87. ;
  88.  
  89. (defvar m3-ide-process ()
  90.   "Process started"
  91. )
  92.  
  93. (defvar m3-ide-process-busy ()
  94.   "A command is currently being processed by the Ide process"
  95. )
  96.  
  97. (defvar m3-ide-buffer ()
  98.   "Buffer where the result of the current Ide process command should go"
  99. )
  100.  
  101. (defvar m3-ide-error-buffer ()
  102.   "Buffer where errors for the current Ide process command should go"
  103. )
  104.  
  105. (defvar m3-ide-error-received ()
  106.   "The error portion of the answer from the Ide process was received"
  107. )
  108.  
  109. (defvar m3-ide-length-received ()
  110.   "Each answer comes with length newline answer (both error and real answer).
  111.    This variable indicates if the answer was received"
  112. )
  113.  
  114. (defvar m3-ide-length ()
  115.   "Length of the answer being received"
  116. )
  117.  
  118. (defvar m3-ide-received ()
  119.   "How much of the expected answer has been received"
  120. )
  121.  
  122. (defvar m3-ide-string-received ()
  123.   "String where the beginning of the answer goes before the answer
  124.    length is extracted"
  125. )
  126.  
  127. ;
  128. ; These functions are used internally.
  129. ;
  130.  
  131. (defun wait-m3-ide-process-busy ()
  132.   (while m3-ide-process-busy 
  133.     (progn 
  134.       (message "Modula-3 Ide busy, waiting...")
  135.       (sit-for 0.1)
  136.     )
  137.   )
  138. )
  139.  
  140. (defun start-m3-ide ()
  141.   "Check if the Modula-3 Ide process is running and start it if not.
  142.    Wait for the current command to complete before returning and
  143.    set the status as busy to prevent another invocation before the
  144.    upcoming command completes. If the previous command did not reset
  145.    m3-ide-process-busy properly, this function may wait indefinitely.
  146.    It can be interrupted with ^G and the m3-ide-process-busy variable
  147.    should be set to nil."
  148.  
  149.   ; There is an m3-ide-process and a buffer attached to it. Thus
  150.   ; the process should be alive.
  151.   (if m3-ide-process 
  152.     (if (buffer-name (process-buffer m3-ide-process))
  153.  
  154.       ; wait until the previous command is completed
  155.       (wait-m3-ide-process-busy)
  156.  
  157.       ; the process must be dead since it has no buffer attached
  158.       ; set it to nil.
  159.       (progn
  160.         (set-process-filter m3-ide-process ())
  161.         (delete-process m3-ide-process)
  162.         (setq m3-ide-process ())
  163.       )
  164.     )
  165.   )
  166.  
  167.   ; Lock the process to insure that only one command at a time is sent.
  168.   (setq m3-ide-process-busy t)
  169.  
  170.   ; A new process must be started. By default uncaught output will go
  171.   ; to *m3-ide* buffer.
  172.   (if (not m3-ide-process)    
  173.     (let ((old-buffer (current-buffer)))
  174.       (setq m3-ide-process
  175.         (start-process "m3-ide" (get-tmpbuf-create-m3 "*m3-ide*")
  176.           "m3ide"
  177.         )
  178.       )
  179.       (process-kill-without-query m3-ide-process)
  180.       (set-buffer "*m3-ide*")
  181.       (while (< (buffer-size) 8)
  182.         (sit-for 0.1)
  183.       )
  184.       (set-buffer old-buffer)
  185.     )
  186.   )
  187. )
  188.  
  189. ;
  190. ; The filter must receive its arguments and store its intermediate
  191. ; results into global variables since it can only receive pre-defined
  192. ; formal arguments from the process sending output back to emacs.
  193. ; The buffers to receive output and error, and variables to indicate
  194. ; what has been received so far are used.
  195. ;
  196.  
  197. (defun prepare-m3-buffers (text-buffer error-buffer)
  198.   "Clear the text-buffer and store the text and error buffer to global
  199.    variables for use by the filter"
  200.  
  201.   ; store the old buffer
  202.   (let ((old-buffer (current-buffer)))
  203.  
  204.     ; erase the buffers and store them in the global variables.
  205.     (setq m3-ide-buffer text-buffer)
  206.     (set-buffer m3-ide-buffer)
  207.     (erase-buffer)
  208.     (setq m3-ide-error-buffer error-buffer)
  209.     (set-buffer m3-ide-error-buffer)
  210.     (erase-buffer)
  211.  
  212.     ; initialize other global variables.
  213.     (setq m3-ide-error-received ())
  214.     (setq m3-ide-length-received ())
  215.     (setq m3-ide-string-received "")
  216.     (set-buffer old-buffer)
  217.   )
  218. )
  219.  
  220. ;
  221. ; The filter is called repeatedly receiving a chunk of the output each time.
  222. ;
  223.  
  224. (defun receive-m3-ide-result (proc string)
  225.   "Accept the result from the Modula-3 Ide process"
  226.  
  227.   ; we are not within a command! no output should be received.
  228.   (if (not m3-ide-process-busy)
  229.     (if (> (length string) 0)
  230.       (progn
  231.         (message (concat "Received unsolicited output from ide " string))
  232.       )
  233.     )
  234.  
  235.     ; Everything received and unprocessed is kept there
  236.     (setq m3-ide-string-received (concat m3-ide-string-received string))
  237.  
  238.     ; first we must receive the length argument.
  239.     (if (not m3-ide-length-received)
  240.       (progn
  241.         ; the characters received are accumulated until the length is received.
  242.         ; The length occupies 10 characters.
  243.         (if (> (length m3-ide-string-received) 10)
  244.           (progn
  245.  
  246.             ; the length is received and extracted. The remaining of the
  247.             ; characters received are part of the value to receive.
  248.             (setq m3-ide-length-received t)
  249.             (let ((length-string (substring m3-ide-string-received 0 10))
  250.                   (rest-string (substring m3-ide-string-received 11))
  251.                  )
  252.               (setq m3-ide-string-received rest-string)
  253.               (setq m3-ide-length (string-to-int length-string))
  254.               (setq m3-ide-received 0)
  255.  
  256.               ; process the remaining part of the characters received.
  257.               (receive-m3-ide-string)
  258.             )
  259.           )
  260.         )
  261.       )
  262.  
  263.       ; The length was already received. This is part of the value to receive.
  264.       (receive-m3-ide-string)
  265.     )
  266.  
  267.     ; We are leaving while there are characters left!
  268.     ; It must be the length for the next value
  269.     (if (> (length m3-ide-string-received) 0)
  270.       (receive-m3-ide-result () "")
  271.     )
  272.   )
  273. )
  274.  
  275. (defun receive-m3-ide-string ()
  276.   "Receive a string into the appropriate buffer"
  277.  
  278.   ; there is more than needed. The part required to complete the
  279.   ; expected length is put into string. The rest is stored into
  280.   ; the m3-ide-string-received variable.
  281.   (let ((string ())
  282.         (old-buffer (current-buffer))
  283.         (new-buffer 
  284.           (if m3-ide-error-received m3-ide-buffer m3-ide-error-buffer)
  285.         )
  286.        )
  287.     (if (> (+ m3-ide-received (length m3-ide-string-received)) m3-ide-length)
  288.       (progn
  289.         (setq string
  290.           (substring m3-ide-string-received 0 
  291.             (- m3-ide-length m3-ide-received)
  292.           )
  293.         )
  294.         (setq m3-ide-string-received 
  295.           (substring m3-ide-string-received (- m3-ide-length m3-ide-received))
  296.         )
  297.       )
  298.       (progn
  299.         (setq string m3-ide-string-received)
  300.         (setq m3-ide-string-received "")
  301.       )
  302.     )
  303.  
  304.     (set-buffer new-buffer)
  305.     (goto-char (point-max))
  306.     (insert string)
  307.     (set-buffer old-buffer)
  308.  
  309.     ; accumulate the characters received.
  310.     (setq m3-ide-received (+ m3-ide-received (length string)))
  311.  
  312.     ; everything was received for this value.
  313.     (if (>= m3-ide-received m3-ide-length)
  314.       (if m3-ide-error-received
  315.         ; The error and ordinary values were received.
  316.         (progn
  317.           (set-process-filter m3-ide-process ())
  318.           (setq m3-ide-process-busy ())
  319.         )
  320.         ; The error value was received and the ordinary value is next.
  321.         (progn
  322.           (setq m3-ide-error-received t)
  323.           (setq m3-ide-length-received ())
  324.         )
  325.       )
  326.     )
  327.   )
  328. )
  329.  
  330. (defvar m3-browser-process ())
  331.  
  332. (defun start-m3-browser ()
  333.   "Check if the Modula-3 browser process is running and start it if not."
  334.   (if (not m3-browser-process)
  335.     (let ((old-buffer (current-buffer)))
  336.       (setq m3-browser-process
  337.         (eval
  338.           (append 
  339.             (list 'start-process "m3-browser" 
  340.               (get-tmpbuf-create-m3 "*m3-browser*")
  341.               "m3browser"
  342.               "-port" "8000" "-base" "" "-mask" "32" "-v"
  343.               "-notitle"
  344.             )
  345.             (let ((root-list ()))
  346.               (mapcar 
  347.                 (lambda(x)
  348.                   (setq root-list (append root-list (list "-root" x)))
  349.                 )
  350.                 m3-source-roots
  351.               )
  352.               root-list
  353.             )
  354.           )
  355.         )
  356.       )
  357.       (process-kill-without-query m3-browser-process)
  358.       (set-buffer "*m3-browser*")
  359.       (while (< (buffer-size) 4)
  360.         (sit-for 0.1)
  361.       )
  362.       (set-buffer old-buffer)
  363.     )
  364.   )
  365. )
  366.  
  367. (defun clean-m3-browser-process () (interactive)
  368.   "Kill the current m3-browser process and clear the associated variables."
  369.   (if m3-browser-process 
  370.     (delete-process m3-browser-process)
  371.   )
  372.   (setq m3-browser-process ())
  373. )
  374.  
  375. ;
  376. ; debugging aids
  377. ;
  378.  
  379. (defun m3-send-debug (string)
  380.   "Write the string to the debug buffer"
  381.   (let ((old-buffer (current-buffer))
  382.         (new-buffer (get-tmpbuf-create-m3 "*m3-debug*"))
  383.        )
  384.     (set-buffer new-buffer)
  385.     (insert string)
  386.     (set-buffer old-buffer)
  387.   )
  388. )
  389.  
  390.  
  391.  
  392.  
  393.