Mercurial > hg > xemacs-beta

annotate tests/tooltalk/simple.el @ 4997:8800b5350a13

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Move #'some, #'every to C, implementing them with mapcarX. src/ChangeLog addition: 2010-02-03 Aidan Kehoe <kehoea@parhasard.net> * fns.c (mapcarX): Accept a new argument, indicating whether the function is being called from #'some or #'every. Implement it. Discard any multiple values where that is appropriate. (Fmapconcat, FmapcarX, Fmapvector, Fmapcan, Fmapc, Fmap) (Fmap_into): Pass the new flag to mapcarX. (Fsome, Fevery): Move these functions here from cl-extra.el; implement them in terms of mapcarX. (maplist): Discard multiple values where appropriate. lisp/ChangeLog addition: 2010-02-03 Aidan Kehoe <kehoea@parhasard.net> * cl-extra.el (some, every): Move these functions to C. * cl-macs.el (notany, notevery): Add compiler macros for these functions, no longer proclaim them inline (which would involve specbinding that's not necessary with the compiler macros).
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 03 Feb 2010 20:26:47 +0000
parents 131b0175ea99
children 9fc91aa3a927
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1 ;;; Example of Sending Messages
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3 (defun tooltalk-random-query-handler (msg pat)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
4 (let ((state (get-tooltalk-message-attribute msg 'state)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
5 (cond
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
6 ((eq state 'TT_HANDLED)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
7 (message (get-tooltalk-message-attribute msg arg_val 0)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
8 ((memq state '(TT_FAILED TT_REJECTED))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
9 (message "Random query turns up nothing")))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
10
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
11 (setq random-query-message
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
12 '( class TT_REQUEST
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
13 scope TT_SESSION
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
14 address TT_PROCEDURE
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
15 op "random-query"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
16 args ((TT_INOUT "?" "string"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
17 callback tooltalk-random-query-handler))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
18
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
19 (let ((m (make-tooltalk-message random-query-message)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
20 (send-tooltalk-message m))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
21
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
22 ;;; Example of Receiving Messaegs
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
23
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
24 (defun tooltalk-display-string-handler (msg pat)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
25 (return-tooltalk-message msg 'reply)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
26 (describe-tooltalk-message msg)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
27 (message (get-tooltalk-message-attribute msg 'arg_val 0)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
28
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
29 (setq display-string-pattern
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
30 '(category TT_HANDLE
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
31 scope TT_SESSION
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
32 op "emacs-eval"
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
33 args ((TT_IN "filename" "string"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
34 callback tooltalk-display-string-handler))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
35
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
36 (let ((p (make-tooltalk-pattern display-string-pattern)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
37 (register-tooltalk-pattern p))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
38