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