home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / p / plbin.zip / pl / lisp / qui_filter.el < prev    next >
Lisp/Scheme  |  1992-05-26  |  5KB  |  156 lines
  1. ; /ports/emacs/GNU/el3.1 @(#)qui_filter.el    1.1 11/15/90 
  2. ; /ports/home/sitaram/Gnu/qui_emacs @(#)qui_filter.el    1.5 11/13/90 
  3. ;;;              QUI - GNU Emacs Interface
  4. ;;;              Support Functions
  5. ;;;
  6. ;;;          Consolidated by Sitaram Muralidhar
  7. ;;;
  8. ;;;             sitaram@quintus.com
  9. ;;;            Quintus Computer Systems, Inc.
  10. ;;;                 12 Nov 1990
  11. ;;;
  12. ;;;    This file defines functions that support the QUI - GNU Emacs
  13. ;;;                  interface.
  14.  
  15. (defvar SIZEOFSIZE           4)
  16. (defvar SIZEOFCOMMAND        8)
  17. (defvar *packet-command*    ""
  18.   "The current command being processed")
  19. (defvar *partial-command*   "")
  20. (defvar *partial-size*      "")
  21. (defvar *current-size*      -1)
  22. (defvar *partial-arg*       "")
  23. (defvar *current-arg*       100)
  24.  
  25.  
  26. ;;;
  27. ;;; begin-reading called from qui-process-filter, checks if the
  28. ;;; command can be read (8 chars), if so it figures out the number of
  29. ;;; units the rest of the packet should have and calls
  30. ;;; process-rest-of-packet. If the command itself is incomplete in
  31. ;;; this packet *partial-command* is set to the part-formed command
  32. ;;; and *qui-packet-pending* is set indicating that there is more to
  33. ;;; come. 
  34. ;;; 
  35.  
  36. (defun begin-reading ( packet )
  37.   (cond ((>= (length packet) SIZEOFCOMMAND)
  38.      ; Command read in full
  39.      (setq *packet-command* (substring packet 0 SIZEOFCOMMAND))
  40.      (setq *partial-command* "")
  41.      (process-rest-of-packet (substring packet SIZEOFCOMMAND)
  42.                  (command-length *packet-command*)))
  43.     ; Do not have full command
  44.     (t (setq *partial-command* packet)     
  45.        (setq *qui-packet-pending* t))
  46.  )
  47. )
  48.  
  49. ;;;
  50. ;;; continue-reading called from qui-process-filter, checks if it is
  51. ;;; in the process of reading a command or the remainder of the
  52. ;;; packet. If reading a command, it checks to see if it has the
  53. ;;; entire command, if so
  54. (defun continue-reading ( packet )
  55.   (if (not (string-equal *partial-command* ""))
  56.       (cond ((>= (+ (length *partial-command*) 
  57.             (length packet))
  58.          SIZEOFCOMMAND)
  59.          ; have command
  60.          (setq *packet-command* 
  61.            (concat *partial-command* 
  62.                (substring packet 0 
  63.                       (setq chars-read 
  64.                         (- SIZEOFCOMMAND
  65.                           (length *partial-command*))))))
  66.          (setq *partial-command* "")
  67.          (process-rest-of-packet (substring packet chars-read) (1- number)))
  68.         ; Incomplete command
  69.         (t (setq *partial-command* (concat *partial-command* packet))
  70.            (setq *qui-packet-pending* t))
  71.       )
  72.       ; No partial command must be processing rest of packet
  73.       (process-rest-of-packet packet (command-length *packet-command*))
  74.    )
  75. )
  76.                
  77. (defun process-rest-of-packet ( packet number )
  78.   (cond ((> number 0)
  79.      (if (not (string-equal *partial-size* ""))
  80.          (cond ((>= (+ (length *partial-size*)
  81.                (length packet)) 
  82.             SIZEOFSIZE)
  83.             (setq *current-size* 
  84.               (string-to-int 
  85.                 (concat *partial-size* 
  86.                     (substring packet 0 
  87.                            (setq chars-read 
  88.                              (- SIZEOFSIZE 
  89.                             (length *partial-size*)))))))
  90.             (setq *partial-size* "")
  91.             (process-arg *current-size* (substring packet chars-read) 
  92.                  number))
  93.            (t (setq *partial-size* (concat *partial-size* packet))))
  94.          ; have full size or no size
  95.          (if (not (equal *current-size* -1))
  96.          (process-arg *current-size* packet number)
  97.          (cond ((>= (length packet) SIZEOFSIZE)
  98.             (setq *current-size* (string-to-int 
  99.                            (substring packet 0 SIZEOFSIZE)))
  100.             (setq *partial-size* "")
  101.             (process-arg *current-size* (substring packet SIZEOFSIZE)
  102.                      number))
  103.                (t (setq *qui-packet-pending* t)
  104.               (setq *partial-size* packet)))
  105.          )
  106.      ))
  107.     (t (setq *qui-packet-pending* nil)
  108.        (process-qui-packets)
  109.        (if (> (length packet) 0)
  110.            ; the packet contains more than one command - begin reading again
  111.            ( begin-reading packet )
  112.        )
  113.         )
  114.      )
  115. )
  116.  
  117. (defun process-arg ( size packet number )
  118.   (if (not (string-equal *partial-arg* ""))
  119.       (cond ((>= (+ (length *partial-arg*)
  120.             (length packet))
  121.          size)
  122.          (set-variable (intern (concat "arg" number))
  123.                (concat *partial-arg* 
  124.                    (substring packet 0 
  125.                           (setq chars-read 
  126.                             (- size 
  127.                                (length *partial-arg*))))))
  128.          (setq *current-arg* number)
  129.          (setq *partial-arg* "")
  130.          (process-rest-of-packet (substring packet chars-read) (1- number)))
  131.         (t (setq *qui-packet-pending* t)
  132.            (setq *current-arg* number)
  133.            (setq *partial-arg* packet))
  134.       )
  135.       ; No arg or full arg
  136.       (if (<= *current-arg* number)
  137.       (process-rest-of-packet packet (1- number))
  138.       ; No arg yet
  139.       (cond ((>= (length packet) size)
  140.          ; Have full arg
  141.          (set-variable (intern (concat "arg" number ))
  142.                    (substring packet 0 size))
  143.          (setq *current-arg* number)
  144.          (setq *current-size* -1)
  145.          (setq *partial-arg* "")
  146.          (process-rest-of-packet (substring packet size) (1- number)))
  147.         (t (setq *qui-packet-pending* t)
  148.            (setq *current-arg* number)
  149.            (setq *partial-arg* packet)))
  150.      )
  151.   )
  152. )              
  153.        
  154.  
  155.  
  156.