Mercurial > hg > xemacs-beta

comparison lisp/games/conx.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children b82b59fe008d
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; -*- Mode:Emacs-Lisp; Blat:Foop -*-
2
3 ;;; conx.el: Yet Another Dissociator.
4 ;;; Original design by Skef Wholey <skef@cs.cmu.edu>;
5 ;;; ported to Emacs-Lisp by Jamie Zawinski <jwz@lucid.com>, 5-mar-91.
6 ;;;
7 (defconst conx-version "1.6, 6-may-94.")
8 ;;;
9 ;;; Run this compiled. It will be an order of magnitude faster.
10 ;;;
11 ;;; Select a buffer with a lot of text in it. Say M-x conx-buffer
12 ;;; or M-x conx-region. Repeat on as many other bodies of text as
13 ;;; you like.
14 ;;;
15 ;;; M-x conx will use the word-frequency tree the above generated
16 ;;; to produce random sentences in a popped-up buffer. It will pause
17 ;;; at the end of each paragraph for two seconds; type ^G to stop it.
18 ;;;
19 ;;; M-x conx-init will clear the data structures so you can start
20 ;;; over. Note that if you run it twice consecutively on the same
21 ;;; body of text, word sequences in that buffer will be twice as
22 ;;; likely to be generated.
23 ;;;
24 ;;; Once you have sucked in a lot of text and like the kinds of
25 ;;; sentences conx is giving you, you can save the internal data
26 ;;; structures to a file with the M-x conx-save command. Loading
27 ;;; this file with M-x conx-load will be a lot faster and easier
28 ;;; than re-absorbing all of the text files. Beware that loading a
29 ;;; saved conx-file clears the conx database in memory.
30 ;;;
31 ;;; M-x conx-emit-c will write out C source code which, when compiled,
32 ;;; will produce a standalone program which generates sentences from
33 ;;; a copy of the database currently loaded.
34 ;;;
35 ;;; Ideas for future improvement:
36 ;;;
37 ;;; o It would be nice if we could load in more than one saved
38 ;;; file at a time.
39 ;;;
40 ;;; o use it to collect statistics on newsgroup conversations by
41 ;;; examining the tree for the most common words and phrases
42 ;;;
43 ;;; o when replying to mail, insert an X-CONX: header field which
44 ;;; contains a sentence randomly generated from the body of the
45 ;;; message being replied to.
46 ;;;
47 ;;; o It could stand to be faster...
48
49 (defvar conx-bounce 10) ; 1/x
50 (defvar conx-hashtable-size 9923) ; 9923 is prime
51 (defconst conx-words-hashtable nil)
52 (defconst conx-words-vector nil)
53 (defconst conx-words-vector-fp 0)
54
55 (defconst conx-last-word nil)
56
57 (defvar conx-files nil "FYI")
58
59 (defun conx-init ()
60 "Forget the current word-frequency tree."
61 (interactive)
62 (if (and conx-words-hashtable
63 (>= (length conx-words-hashtable) conx-hashtable-size))
64 (fillarray conx-words-hashtable 0)
65 (setq conx-words-hashtable (make-vector conx-hashtable-size 0)))
66 (if conx-words-vector
67 (fillarray conx-words-vector nil)
68 (setq conx-words-vector (make-vector 1000 nil))) ; this grows
69 (setq conx-words-vector-fp 0)
70 (setq conx-last-word nil
71 conx-files nil))
72
73 (defun conx-rehash ()
74 ;; misnomer; this just grows the linear vector, growing the hash table
75 ;; is too hard.
76 (message "Rehashing...")
77 (let* ((L (length conx-words-vector))
78 (v2 (make-vector (+ L L) nil)))
79 (while (< 0 L)
80 (aset v2 (1- L) (aref conx-words-vector (setq L (1- L)))))
81 (setq conx-words-vector v2)
82 )
83 (message "Rehashing...done"))
84
85 (defmacro conx-count (word) (list 'aref word 0))
86 (defmacro conx-cap (word) (list 'aref word 1))
87 (defmacro conx-comma (word) (list 'aref word 2))
88 (defmacro conx-period (word) (list 'aref word 3))
89 (defmacro conx-quem (word) (list 'aref word 4))
90 (defmacro conx-bang (word) (list 'aref word 5))
91 (defmacro conx-succ (word) (list 'aref word 6))
92 (defmacro conx-pred (word) (list 'aref word 7))
93 (defmacro conx-succ-c (word) (list 'aref word 8))
94 (defmacro conx-pred-c (word) (list 'aref word 9))
95 (defconst conx-length 10)
96
97 (defmacro conx-make-word ()
98 '(copy-sequence '[1 0 0 0 0 0 nil nil 0 0]))
99
100 (defmacro conx-setf (form val) ; mind-numbingly simple
101 (setq form (macroexpand form (and (boundp 'byte-compile-macro-environment)
102 byte-compile-macro-environment)))
103 (cond ((symbolp form) (list 'setq form val))
104 ((eq (car form) 'aref) (cons 'aset (append (cdr form) (list val))))
105 ((eq (car form) 'cdr) (list 'setcdr (nth 1 form) val))
106 ((eq (car form) 'car) (list 'setcar (nth 1 form) val))
107 (t (error "can't setf %s" form))))
108
109 (defmacro conx-push (thing list)
110 (list 'conx-setf list (list 'cons thing list)))
111
112 (defconst conx-most-positive-fixnum (lsh -1 -1)
113 "The largest positive integer that can be represented in this emacs.")
114
115 (defmacro conx-rand (n)
116 (list '% (list 'logand 'conx-most-positive-fixnum '(random)) n))
117
118 (defmacro conx-relate-succ (word related)
119 (` (let ((vec (symbol-value (, word))))
120 (conx-setf (conx-succ-c vec) (1+ (conx-succ-c vec)))
121 (let ((rel (assq (, related) (conx-succ vec))))
122 (if rel
123 (setcdr rel (1+ (cdr rel)))
124 (conx-push (cons (, related) 1) (conx-succ vec)))))))
125
126 (defmacro conx-relate-pred (word related)
127 (` (let ((vec (symbol-value (, word))))
128 (conx-setf (conx-pred-c vec) (1+ (conx-pred-c vec)))
129 (let ((rel (assq (, related) (conx-pred vec))))
130 (if rel
131 (setcdr rel (1+ (cdr rel)))
132 (conx-push (cons (, related) 1) (conx-pred vec)))))))
133
134 (defmacro conx-add-word (word)
135 (` (let* ((word (, word))
136 (fc (aref word 0)))
137 (setq word (intern (downcase word) conx-words-hashtable))
138 (let ((vec (and (boundp word) (symbol-value word))))
139 (if vec
140 (conx-setf (conx-count vec) (1+ (conx-count vec)))
141 (if (= conx-words-vector-fp (length conx-words-vector))
142 (conx-rehash))
143 (set word (setq vec (conx-make-word)))
144 (aset conx-words-vector conx-words-vector-fp word)
145 (setq conx-words-vector-fp (1+ conx-words-vector-fp)))
146 (or (< fc ?A) (> fc ?Z)
147 (conx-setf (conx-cap vec) (1+ (conx-cap vec)))))
148 (if conx-last-word
149 (progn
150 (conx-relate-succ conx-last-word word)
151 (conx-relate-pred word conx-last-word)))
152 (setq conx-last-word word))))
153
154 (defmacro conx-punx (char)
155 (` (if conx-last-word
156 (let ((char (, char))
157 (vec (symbol-value conx-last-word)))
158 (cond ((eq char ?\,)
159 (conx-setf (conx-comma vec) (1+ (conx-comma vec))))
160 ((or (eq char ?\.)
161 (eq char ?\;))
162 (conx-setf (conx-period vec) (1+ (conx-period vec)))
163 (setq conx-last-word nil))
164 ((eq char ?\?)
165 (conx-setf (conx-quem vec) (1+ (conx-quem vec)))
166 (setq conx-last-word nil))
167 ((eq char ?\!)
168 (conx-setf (conx-bang vec) (1+ (conx-bang vec)))
169 (setq conx-last-word nil)))))))
170
171 (defun conxify-internal ()
172 (let (p w)
173 (while (not (eobp))
174 (skip-chars-forward "^A-Za-z0-9'")
175 (while (memq (following-char) '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?\'))
176 ;; ignore words beginning with digits
177 (skip-chars-forward "A-Za-z0-9'")
178 (skip-chars-forward "^A-Za-z0-9'"))
179 (setq p (point))
180 (skip-chars-forward "A-Za-z0-9'")
181 (if (= ?\' (preceding-char)) (forward-char -1))
182 (if (eq p (point))
183 nil
184 (setq w (buffer-substring p (point)))
185 (if (equal "nil" w) ; hey, nil is totally magic, this doesn't work!
186 nil
187 (conx-add-word w)
188 (setq n (1+ n))
189 (skip-chars-forward " \t\n\r")
190 (if (memq (setq p (following-char)) '(?\, ?\. ?\! ?\? ?\;))
191 (conx-punx p)))))))
192
193 ;;;###autoload
194 (defun conx-buffer ()
195 "Absorb the text in the current buffer into the tree."
196 (interactive)
197 (or conx-words-vector (conx-init))
198 (let ((i conx-words-vector-fp)
199 (n 0)
200 (pm (point-max)))
201 (save-excursion
202 (goto-char (point-min))
203 (save-restriction
204 (widen)
205 (while (< (setq p (point)) pm)
206 (search-forward "\n\n" pm 0)
207 (narrow-to-region p (point))
208 (goto-char (prog1 p (setq p (point))))
209 (conxify-internal)
210 (widen)
211 (message "%d%%..." (/ (* p 100) (point-max))))))
212 (if buffer-file-name
213 (setq conx-files (nconc conx-files (list buffer-file-name))))
214 (message "%s words, %d unique" n (- conx-words-vector-fp i))))
215
216 ;;;###autoload
217 (defun conx-region (p m)
218 "Absorb the text in the current region into the tree."
219 (interactive "r")
220 (save-restriction
221 (widen)
222 (narrow-to-region p m)
223 (conx-buffer)))
224
225 (defun conx-mail-buffer ()
226 "Conxify a buffer in /bin/mail format."
227 (interactive)
228 (save-excursion
229 (goto-char (point-min))
230 (skip-chars-forward "\n \t")
231 (let ((case-fold-search nil)
232 (buffer-file-name nil)
233 p p2 p3)
234 (or (looking-at "^From ") (error "not in /bin/mail format"))
235 (while (not (eobp))
236 (search-forward "\n\n" nil 0)
237 (setq p (point))
238 (search-forward "\nFrom " nil 0)
239 (setq p3 (setq p2 (point)))
240 ;; don't count ".signature" sections.
241 (and (re-search-backward "\n--+\n" nil t)
242 (< (count-lines (point) p2) 9)
243 (setq p2 (point)))
244 (conx-region p (point))
245 (goto-char p3)))
246 (if buffer-file-name
247 (setq conx-files (nconc conx-files (list buffer-file-name))))
248 ))
249
250 ;;; output
251
252 (defun conx-random-related (count list)
253 (let ((foll (if (= 0 count) 0 (conx-rand count)))
254 ans)
255 (while list
256 (if (<= foll (cdr (car list)))
257 (setq ans (car (car list))
258 list nil)
259 (setq foll (- foll (cdr (car list)))
260 list (cdr list))))
261 ans))
262
263 (defun conx-random-succ (word)
264 (if (= 0 (conx-succ-c (symbol-value word)))
265 word
266 (let ((next (conx-random-related
267 (conx-succ-c (symbol-value word))
268 (conx-succ (symbol-value word)))))
269 (if (= 0 (conx-rand conx-bounce))
270 (conx-random-succ
271 (conx-random-related
272 (conx-pred-c (symbol-value next))
273 (conx-pred (symbol-value next))))
274 next))))
275
276
277 (defun conx-sentence ()
278 (or (> conx-words-vector-fp 0)
279 (error "no conx data is loaded; see `conx-buffer'."))
280 (let* ((word (aref conx-words-vector (conx-rand conx-words-vector-fp)))
281 (first-p t)
282 (p (point))
283 vec punc str)
284 (while word
285 (setq punc (conx-rand (conx-count (setq vec (symbol-value word)))))
286 (if (or first-p
287 ;; (< (conx-rand (conx-count vec)) (conx-cap vec))
288 (= (conx-count vec) (conx-cap vec))
289 )
290 (progn
291 (setq first-p nil)
292 (setq str (symbol-name word))
293 (insert (+ (- ?A ?a) (aref str 0)))
294 (insert (substring str 1)))
295 (insert (symbol-name word)))
296 (cond ((< punc (conx-comma vec))
297 (insert ", "))
298 ((< (setq punc (- punc (conx-comma vec))) (conx-period vec))
299 (setq word nil)
300 (if (= 0 (conx-rand 5))
301 (if (= 0 (conx-rand 4))
302 (insert ": ")
303 (insert "; "))
304 (insert ". ")))
305 ((< (setq punc (- punc (conx-period vec))) (conx-quem vec))
306 (setq word nil)
307 (insert "? "))
308 ((< (setq punc (- punc (conx-quem vec))) (conx-bang vec))
309 (setq word nil)
310 (insert "! "))
311 (t
312 (insert " ")
313 (if (= 0 (conx-succ-c vec)) (setq word nil))))
314 (if word
315 (setq word (conx-random-succ word))))
316 (fill-region-as-paragraph (save-excursion
317 (goto-char p)
318 (beginning-of-line)
319 (point))
320 (point))
321 (if (= (preceding-char) ?\n)
322 (if (= 0 (conx-rand 4))
323 (insert "\n")
324 (delete-char -1)
325 (insert " "))))
326 nil)
327
328 ;;;###autoload
329 (defun conx ()
330 "Generate some random sentences in the *conx* buffer."
331 (interactive)
332 (display-buffer (set-buffer (get-buffer-create "*conx*")))
333 (select-window (get-buffer-window "*conx*"))
334 (message "type ^G to stop.")
335 (while t
336 (goto-char (point-max))
337 (sit-for (if (= (preceding-char) ?\n) 2 0))
338 (conx-sentence)))
339
340
341 ;;; GNUS interface; grab words from the current message.
342
343 (defun conx-gnus-snarf ()
344 "For use as a gnus-select-article-hook."
345 (set-buffer gnus-article-buffer)
346 (save-excursion
347 (save-restriction
348 (widen)
349 (goto-char (point-min))
350 (search-forward "\n\n" nil t)
351 (conx-region (point) (point-max)))))
352
353 ;;(add-hook 'gnus-select-article-hook 'conx-gnus-snarf)
354
355 (defun psychoanalyze-conx ()
356 "Mr. Random goes to the analyst."
357 (interactive)
358 (doctor) ; start the psychotherapy
359 (message "")
360 (switch-to-buffer "*doctor*")
361 (sit-for 0)
362 (while (not (input-pending-p))
363 (conx-sentence)
364 (if (= (random 2) 0)
365 (conx-sentence))
366 (sit-for 0)
367 (doctor-ret-or-read 1)))
368
369
370 ;;; Saving the database
371
372 (defun conx-save (file)
373 "Save the current CONX database to a file for future retrieval.
374 You can re-load this database with the \\[conx-load] command."
375 (interactive "FSave CONX corpus to file: ")
376 (save-excursion
377 (let (b)
378 (unwind-protect
379 (progn
380 (set-buffer (setq b (get-buffer-create "*conx-save-tmp*")))
381 (delete-region (point-min) (point-max))
382 (insert ";;; -*- Mode:Emacs-Lisp -*-\n")
383 (insert ";;; This is a CONX database file. Load it with `conx-load'.\n")
384 (if conx-files
385 (insert ";;; Corpus: " (mapconcat 'identity conx-files ", ") "\n"))
386 (insert ";;; Date: " (current-time-string) "\n\n")
387 ;; The file format used here is such a cute hack that I'm going to
388 ;; leave it as an excercise to the reader to figure it out.
389 (let ((p (point))
390 (fill-column 78)
391 (fill-prefix "\t")
392 (i 0))
393 (insert "(!! [\t")
394 (while (< i conx-words-vector-fp)
395 (prin1 (aref conx-words-vector i) (current-buffer))
396 (insert " ")
397 (setq i (1+ i)))
398 (insert "])\n")
399 (fill-region-as-paragraph p (point))
400 (insert "\n"))
401 (mapatoms (function (lambda (sym)
402 (if (not (boundp sym))
403 nil
404 (insert "\(! ")
405 (prin1 sym (current-buffer))
406 (insert " ")
407 (prin1 (symbol-value sym) (current-buffer))
408 (insert "\)\n"))))
409 conx-words-hashtable)
410 (goto-char (point-min))
411 (while (re-search-forward "\\bnil\\b" nil t)
412 (replace-match "()"))
413 (set-visited-file-name file)
414 (save-buffer)))
415 (and b (kill-buffer b)))))
416
417 ;;;###autoload
418 (defun conx-load (file)
419 "Load in a CONX database written by the \\[conx-save] command.
420 This clears the database currently in memory."
421 (interactive "fLoad CONX corpus from file: ")
422 (conx-init)
423 (fset (intern "!!" conx-words-hashtable)
424 (function (lambda (vec)
425 (setq conx-words-vector vec
426 conx-words-vector-fp (length vec)))))
427 (fset (intern "!" conx-words-hashtable)
428 (symbol-function 'setq))
429 (let ((obarray conx-words-hashtable))
430 (load file)))
431
432
433 ;;; Emitting C code
434
435 (defun conx-emit-c-data (&optional ansi-p)
436 (let ((all '())
437 (standard-output (current-buffer))
438 (after-change-functions nil) ; turning off font-lock speeds it up x2
439 (before-change-functions nil)
440 (after-change-function nil)
441 (before-change-function nil)
442 (float-output-format "%.2f")
443 count total total100)
444 (or conx-words-hashtable (error "no words"))
445 (let ((i 0))
446 (mapatoms (function (lambda (x)
447 (if (boundp x)
448 (setq all (cons (cons i x) all)
449 i (1+ i)))))
450 conx-words-hashtable))
451 (setq all (nreverse all))
452 (setq total (* 4 (length all))
453 total100 (max 1 (if (featurep 'lisp-float-type)
454 (/ (float total) 100)
455 (/ total 100)))
456 count 0)
457 (let ((rest all)
458 (i 5)
459 rest2
460 word)
461 (insert "static unsigned short D[] = {")
462 (while rest
463 (setq word (symbol-value (cdr (car rest))))
464 (setq rest2 (conx-pred word))
465 (setq count (1+ count))
466 (while rest2
467 (princ (cdr (car rest2))) (insert ",")
468 (princ (car (rassq (car (car rest2)) all)))
469 (insert ",")
470 (setq i (1+ i))
471 (cond ((> i 10)
472 (insert "\n")
473 (setq i 0)))
474 (setq rest2 (cdr rest2)))
475 (message "Writing C code... %s%%" (/ count total100))
476 (setq count (1+ count))
477 (setq rest2 (conx-succ word))
478 (while rest2
479 (princ (cdr (car rest2)))
480 (insert ",")
481 (princ (car (rassq (car (car rest2)) all)))
482 (insert ",")
483 (setq i (1+ i))
484 (cond ((> i 10)
485 (insert "\n")
486 (setq i 0)))
487 (setq rest2 (cdr rest2)))
488 (message "Writing C code... %s%%" (/ count total100))
489 (setq count (1+ count))
490 (setq rest (cdr rest))))
491 (insert "0};\nstatic char T[] = \"")
492 (let ((rest all)
493 (i 0) (j 20)
494 k word)
495 (while rest
496 (setq word (symbol-name (cdr (car rest))))
497 (setq k (1+ (length word))
498 i (+ i k)
499 j (+ j k 3))
500 (cond ((> j 77)
501 (insert (if ansi-p "\"\n\"" "\\\n"))
502 (setq j (+ k 3))))
503 (insert word) ; assumes word has no chars needing backslashes
504 (insert "\\000")
505 (message "Writing C code... %s%%" (/ count total100))
506 (setq count (1+ count))
507 (setq rest (cdr rest))))
508 (insert "\";\nstatic struct conx_word words [] = {")
509 (let ((rest all)
510 (i 0) (j 0)
511 cons name word)
512 (while rest
513 (setq cons (car rest)
514 name (symbol-name (cdr cons))
515 word (symbol-value (cdr cons)))
516 (insert "{") (princ (conx-count word))
517 (insert ",") (princ (conx-cap word))
518 (insert ",") (princ (conx-comma word))
519 (insert ",") (princ (conx-period word))
520 (insert ",") (princ (conx-quem word))
521 (insert ",") (princ (conx-bang word))
522 (if (null (conx-pred word))
523 (insert ",0")
524 (insert ",")
525 (princ i)
526 (setq i (+ i (* 2 (length (conx-pred word))))))
527 (if (null (conx-succ word))
528 (insert ",0,")
529 (insert ",")
530 (princ i)
531 (insert ",")
532 (setq i (+ i (* 2 (length (conx-succ word))))))
533 (princ (conx-pred-c word)) (insert ",")
534 (princ (conx-succ-c word)) (insert ",")
535 (princ j)
536 (setq j (+ j (length name) 1))
537 (insert (if (cdr rest) (if (= 0 (% (car cons) 2)) "},\n" "},") "}"))
538 (message "Writing C code... %s%%" (/ count total100))
539 (setq count (1+ count))
540 (setq rest (cdr rest))
541 ))
542 (insert "};\n#define conx_bounce ")
543 (princ conx-bounce)
544 (insert "\n")
545 (message "Writing C code... done.")
546 ))
547
548 (defvar conx-c-prolog "\
549 #if __STDC__
550 #include <stddef.h>
551 #include <unistd.h>
552 extern long random (void);
553 extern void srandom (int);
554 extern void abort (void);
555 #endif
556 #include <stdio.h>
557 #include <time.h>
558
559 struct conx_word {
560 unsigned short count;
561 unsigned short cap;
562 unsigned short comma;
563 unsigned short period;
564 unsigned short quem;
565 unsigned short bang;
566 unsigned short pred;
567 unsigned short succ;
568 unsigned short npred;
569 unsigned short nsucc;
570 unsigned short text;
571 };
572 ")
573
574 (defvar conx-c-code "\
575 #define countof(x) (sizeof((x)) / sizeof(*(x)))
576 #define conx_rand(n) (random()%(n))
577
578 static struct conx_word *
579 conx_random_related (count, which_list)
580 unsigned short count, which_list;
581 {
582 unsigned short *list = D + which_list;
583 int i = 0;
584 unsigned short foll = (count == 0 ? 0 : conx_rand (count));
585 while (1)
586 {
587 if (foll <= list [i * 2])
588 {
589 if ((list [i * 2 + 1]) > countof (words))
590 abort ();
591 return &words [list [i * 2 + 1]];
592 }
593 foll -= list [i * 2];
594 i++;
595 }
596 }
597
598 static struct conx_word *
599 conx_random_succ (word)
600 struct conx_word *word;
601 {
602 if (word->nsucc == 0)
603 return word;
604 else
605 {
606 struct conx_word *next = conx_random_related (word->nsucc, word->succ);
607 if (conx_rand (conx_bounce) != 0)
608 return next;
609 return conx_random_succ (conx_random_related (next->npred, next->pred));
610 }
611 }
612
613 static void
614 conx_sentence ()
615 {
616 static int x = 0;
617 struct conx_word *word = 0;
618 int first_p = 1;
619 int done = 0;
620 int count = 0;
621 while (!done)
622 {
623 int punc;
624 char *text;
625 int L;
626 if (word)
627 word = conx_random_succ (word);
628 else
629 word = &words [conx_rand (countof (words))];
630 count++;
631 punc = conx_rand (word->count);
632 text = T + word->text;
633 L = strlen (text);
634 if (x + L > 70)
635 {
636 putchar ('\\n');
637 x = 0;
638 }
639 x += L+1;
640
641 if (first_p || (word->count == word->cap))
642 {
643 putchar ((*text >= 'a' && *text <= 'z') ? *text + ('A'-'a') : *text);
644 fputs (text+1, stdout);
645 first_p = 0;
646 }
647 else
648 fputs (text, stdout);
649
650 if (punc < word->comma)
651 {
652 fputs (\", \", stdout);
653 x++;
654 }
655 else if ((punc -= word->comma) < word->period)
656 {
657 x++;
658 if (count > 120 || conx_rand (5) != 0)
659 {
660 done = 1;
661 fputs (\". \", stdout);
662 x++;
663 }
664 else
665 {
666 word = 0;
667 if (conx_rand (4) == 0)
668 fputs (\": \", stdout);
669 else
670 fputs (\"; \", stdout);
671 }
672 }
673 else if ((punc -= word->period) < word->quem)
674 {
675 done = 1;
676 fputs (\"? \", stdout);
677 x += 2;
678 }
679 else if ((punc -= word->quem) < word->bang)
680 {
681 done = 1;
682 fputs (\"! \", stdout);
683 x += 2;
684 }
685 else
686 {
687 if (word->nsucc == 0)
688 {
689 fputs (\". \", stdout);
690 x += 2;
691 done = 1;
692 }
693 else
694 putchar (' ');
695 }
696 }
697 if (conx_rand (3) == 0)
698 {
699 fputs (\"\\n\\n\", stdout);
700 x = 0;
701 }
702 }
703
704 main (argc, argv)
705 int argc;
706 char **argv;
707 {
708 unsigned int howmany, delay;
709 char dummy;
710 if (argc == 1)
711 {
712 howmany = 1;
713 delay = 0;
714 }
715 else if (argc == 2 &&
716 1 == sscanf (argv[1], \"%ud%c\", &howmany, &dummy))
717 delay = 0;
718 else if (argc == 3 &&
719 1 == sscanf (argv[1], \"%ud%c\", &howmany, &dummy) &&
720 1 == sscanf (argv[2], \"%ud%c\", &delay, &dummy))
721 ;
722 else
723 {
724 fprintf (stderr, \"usage: %s [count [delay]]\\n\", argv [0]);
725 exit (1);
726 }
727
728 srandom (time (0));
729 if (howmany == 0)
730 howmany = ~0;
731 while (howmany > 0)
732 {
733 conx_sentence ();
734 fflush (stdout);
735 howmany--;
736 if (delay) sleep (delay);
737 }
738 putchar ('\\n');
739 exit (0);
740 }
741 ")
742
743 (defun conx-emit-c (file &optional non-ansi-p)
744 "Write the current CONX database to a file as C source code.
745 The generated program will have the same effect as M-x conx,
746 except that it runs without emacs.
747
748 With a prefix argument, write K&R C instead of ANSI C. ANSI is
749 the default because, without a certain ANSI feature, large databases
750 will overflow static limits in most K&R preprocessors."
751 (interactive "FWrite C file: \nP")
752 (find-file file)
753 (erase-buffer)
754 (let ((buffer-undo-list t))
755 (insert conx-c-prolog)
756 (if (not non-ansi-p)
757 (insert "\n#if !__STDC__\n"
758 "error! this file requires an ANSI C compiler\n"
759 "#endif\n\n"))
760 (conx-emit-c-data (not non-ansi-p))
761 (insert conx-c-code))
762 (goto-char (point-min)))
763
764
765 ;;; Reporting stats
766
767 (defun conx-stats ()
768 (set-buffer (get-buffer-create "*conx-stats*"))
769 (delete-region (point-min) (point-max))
770 (mapatoms (function (lambda (x)
771 (or (not (boundp x))
772 (progn
773 (insert (format "%s" (conx-count (symbol-value x))))
774 (insert "\t\t")
775 (insert (symbol-name x))
776 (insert "\n")))))
777 conx-words-hashtable)
778 (sort-numeric-fields -1 (point-min) (point-max)))
779