Fix some bugs in fns.c, discovered in passing while doing other work. 2010-11-14 Aidan Kehoe <kehoea@parhasard.net> * fns.c (Fnreverse): Check that non-list sequences are writable from Lisp before modifying them. (There's an argument that we should do this for list sequences too, but for the moment other code (e.g. #'setcar) doesn't.) (mapcarX): Initialise lisp_vals_staging, lisp_vals_type explicitly, for the sake of compile warnings. Check if lisp_vals_staging is non-NULL when deciding whether to replace a string's range. (Fsome): Cross-reference to #'find-if in the doc string for this function. (Freduce): GCPRO accum in this function, when a key argument is specicified it can be silently garbage-collected. When deciding whether to iterate across a string, check whether the cursor exceeds the byte len; while iterating, increment an integer counter. Don't ABORT() if check_sequence_range() returns when handed a suspicious sequence; it is legal to supply the length of SEQUENCE as the :end keyword value, and this will provoke our suspicions, legitimately enough. (Problems with this function revealed by Paul Dietz' ANSI test suite, thank you Paul Dietz.) (Freplace): Check list sequence lengths using the arguments, not the conses we're currently looking at, thank you Paul Dietz.

;;; Example of Sending Messages

(defun tooltalk-random-query-handler (msg pat)
  (let ((state (get-tooltalk-message-attribute msg 'state)))
    (cond
      ((eq state 'TT_HANDLED)
       (message (get-tooltalk-message-attribute msg arg_val 0)))
      ((memq state '(TT_FAILED TT_REJECTED))
       (message "Random query turns up nothing")))))

(setq random-query-message
  '(   class TT_REQUEST
       scope TT_SESSION
     address TT_PROCEDURE
	  op "random-query"
        args ((TT_INOUT "?" "string"))
    callback tooltalk-random-query-handler))

(let ((m (make-tooltalk-message random-query-message)))
      (send-tooltalk-message m))

;;; Example of Receiving Messaegs

(defun tooltalk-display-string-handler (msg pat)
  (return-tooltalk-message msg 'reply)
  (describe-tooltalk-message msg)
  (message (get-tooltalk-message-attribute msg 'arg_val 0)))

(setq display-string-pattern
  '(category TT_HANDLE
       scope TT_SESSION
	  op "emacs-eval"
	args ((TT_IN "filename" "string"))
    callback tooltalk-display-string-handler))

(let ((p (make-tooltalk-pattern display-string-pattern)))
  (register-tooltalk-pattern p))