- Timestamp:
- 07/20/04 19:08:46 (21 years ago)
- Location:
- trunk/example
- Files:
-
- 2 edited
-
cliki.lisp (modified) (8 diffs)
-
specbot.lisp (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
TabularUnified trunk/example/cliki.lisp ¶
r46 r48 151 151 :contents contents) 152 152 *pending-memos*)) 153 154 (defun remove-memos (to &key from) 155 (let ((count 0)) 156 (setf *pending-memos* 157 (remove-if #'(lambda (m) 158 (and (string-equal (without-non-alphanumeric to) 159 (memo-to m)) 160 (or (not from) 161 (string-equal (without-non-alphanumeric from) 162 (memo-from m))) 163 (incf count))) 164 *pending-memos*)) 165 count)) 153 166 154 167 (defun lookup-paste (number) … … 258 271 (setf first-line (regex-replace-all "\\n" first-line " ")) 259 272 (setf first-line (regex-replace-all "_\\(([^)]*)\\)" first-line "\\1")) 273 (setf first-line (regex-replace-all "#H\\(([^)]*)\\)" first-line "\\1")) 260 274 (setf first-line (regex-replace-all "\\*\\(([^)]*)\\)" first-line "\\1")) 261 275 (setf first-line (regex-replace-all "<[^>]+>" first-line "")) … … 302 316 ,(lambda (nick) 303 317 (format nil "To send a memo, say something like ``~A: memo for nick: the memo''. I'll remember the memo for any nick which is the same as the given nick, +/- differences in punctuation, and any nick which is an alias for it, and give it to them when they next speak." nick))) 318 ("avoiding memos" . 319 ,(lambda (nick) 320 (format nil "To flush all your memos without delivery, say something like ``~A: discard my memos''. To flush only memos from a specific person, say ``~A: discard my memos from person''." nick nick))) 304 321 ("nicknames" . 305 322 ,(lambda (nick) … … 327 344 (string #\s)))))))) 328 345 346 (defun random-element (list) 347 (elt list (random (length list)))) 348 349 (defparameter *last-eliza-times* (make-list 6 :initial-element 0)) 350 351 (defparameter *last-warning-time* 0) 352 353 (defun do-eliza (first-pass) 354 (if (> (- (get-universal-time) 30) 355 *last-warning-time*) 356 (let ((time-6 (first *last-eliza-times*)) 357 (time-4 (third *last-eliza-times*)) 358 (time-2 (fifth *last-eliza-times*)) 359 (current-time (get-universal-time)) 360 (count 0) 361 (overload 0)) 362 (if (or 363 (and 364 (< (- current-time 15) 365 time-2) 366 (setf count 3) 367 (setf overload (- current-time time-2))) 368 (and 369 (< (- current-time 45) 370 time-4) 371 (setf count 5) 372 (setf overload (- current-time time-4))) 373 (and 374 (< (- current-time 75) 375 time-6) 376 (setf count 7) 377 (setf overload (- current-time time-6)))) 378 (progn 379 (setf *last-warning-time* (get-universal-time)) 380 (format nil "Would you /please/ stop playing with me? ~A messages in ~A seconds is too many." count overload)) 381 (progn 382 (setf *last-eliza-times* (nconc (cdr *last-eliza-times*) 383 (list (get-universal-time)))) 384 (ignore-errors (eliza::eliza first-pass))) 385 386 )))) 387 329 388 (defun cliki-lookup (term-with-question &key sender channel) 330 389 (let ((first-pass (regex-replace-all "^(\\s*)([^?]+)(\\?*)$" term-with-question "\\2")) … … 333 392 (setf first-pass (regex-replace-all "\\s*$" first-pass "")) 334 393 (let ((scanned (or (nth-value 1 (scan-to-strings "^add\\s+\"([^\"]+)\"\\s+as:*\\s+(.+)$" first-pass)) 335 394 (nth-value 1 (scan-to-strings "^add\\s+(.+)\\s+as:*\\s+(.+)$" first-pass))))) 336 395 (if scanned 337 396 (let ((term (elt scanned 0)) … … 339 398 (add-small-definition term defn) 340 399 "OK, done.") 341 (let ((scanned (or 342 (nth-value 1 (scan-to-strings "^alias\\s+\"([^\"]+)\"\\s+as:*\\s+(.+)$" first-pass)) 343 (nth-value 1 (scan-to-strings "^alias\\s+(.+)\\s+as:*\\s+(.+)$" first-pass)) 344 (nth-value 1 (scan-to-strings "^(.+)\\s+is\\s+another\\s+(name|word)\\s+for:*\\s+([^.]+)\\.*$" first-pass))))) 345 (if scanned 346 (let ((term (elt scanned 0)) 347 (defn (elt scanned (1- (length scanned))))) 348 (add-alias term defn) 349 "OK, done.") 350 (progn 351 (setf first-pass (regex-replace-all "(:|/|\\\\|\\#)" first-pass "")) 352 (when (and (scan "^(?i)lisppaste(\\s|!|\\?|\\.|$)*" first-pass) 353 (find-package :lisppaste) 354 channel 355 (> (length channel) 0) 356 (char= (elt channel 0) #\#) 357 (funcall (intern "SAY-HELP" :lisppaste) 358 channel)) 359 (return-from cliki-lookup nil)) 360 361 (or 362 (if (string-equal first-pass "help") 363 (cliki-bot-help *cliki-nickname*)) 364 (let ((strings (nth-value 1 (scan-to-strings "^(?i)help\\s\"*([^\"]+)\"*$" first-pass)))) 365 (when strings 366 (cliki-find-help (elt strings 0)))) 367 (let ((strings (nth-value 1 (scan-to-strings "^(?i)(memo|note)\\s+(for|to)\\s+(\\S+)\\s*[:,]+\\s+(.+)$" term-with-question)))) 368 (when (and sender strings) 369 (if (string-equal (without-non-alphanumeric 370 (elt strings 2)) 371 (without-non-alphanumeric 372 *cliki-nickname*)) 373 "Buzz off." 374 (progn 375 (add-memo 376 sender 377 (if (member (elt strings 2) '("self" "myself" "me") :test #'string-equal) 378 sender 379 (elt strings 2)) 380 (elt strings 3)) 381 (format nil "Remembered. I'll tell ~A when he/she/it next speaks." (elt strings 2)))))) 382 (let ((to-forget (nth-value 1 (scan-to-strings "^forget\\s+([^.]+)\\.*$" first-pass)))) 383 (when to-forget 384 (forget (elt to-forget 0)) 385 (format nil "What's ~A? Never heard of it." (elt to-forget 0)))) 386 (let ((strs (nth-value 1 (scan-to-strings "^(?i)paste\\s+(\\d+)$" first-pass)))) 387 (and strs 388 (lookup-paste (parse-integer (elt strs 0))))) 389 (if (scan "^(?i)hello(\\s|$)*" first-pass) "what's up?") 390 (if (scan "^(?i)hi(\\s|$)*" first-pass) "what's up?") 391 (if (scan "^(?i)yo(\\s|$)*" first-pass) "what's up?") 392 (if (scan "^(?i)thank(s| you)(\\s|!|\\?|\\.|$)*" first-pass) 393 (if sender 394 (format nil "~A: you failed the inverse turing test!" sender) 395 "you failed the inverse turing test!")) 396 (if (scan "^(?i)version(\\s|!|\\?|\\.|$)*" first-pass) 397 (format nil "This is the minion bot, running on a ~A (~A) and running under ~A ~A." (machine-type) (machine-version) (lisp-implementation-type) (lisp-implementation-version))) 398 (if (scan "^(?i)(?i)do my bidding!*$" first-pass) "Yes, my master.") 399 (if (should-do-lookup first-pass (or channel sender "")) 400 (aif (or (small-definition-lookup first-pass) 401 (cliki-first-sentence first-pass) 402 (alias-lookup first-pass)) 403 (prog1 404 (concatenate 'string first-pass ": " it) 405 (did-lookup first-pass (or channel sender "")))) 406 (setf should-send-cant-find nil)) 407 (if (or 408 (scan "(!|\\.|\\s.+\\?|\\)|\\()\\s*$" term-with-question) 409 (scan "^\\s*\\S+\\s+\\S+.*$" term-with-question)) 410 ;;(generate-text (+ 20 (random 6))) 411 (ignore-errors (eliza::eliza first-pass)) 412 ) 413 (when should-send-cant-find 414 (format nil "Sorry, I couldn't find anything in the database for ``~A''.~A" first-pass (if (scan " " first-pass) " Maybe you meant to end with punctuation?" ""))) 415 )))))))) 416 400 (let ((scanned (or 401 (nth-value 1 (scan-to-strings "^alias\\s+\"([^\"]+)\"\\s+as:*\\s+(.+)$" first-pass)) 402 (nth-value 1 (scan-to-strings "^alias\\s+(.+)\\s+as:*\\s+(.+)$" first-pass)) 403 (nth-value 1 (scan-to-strings "^(.+)\\s+is\\s+another\\s+(name|word)\\s+for:*\\s+([^.]+)\\.*$" first-pass))))) 404 (if scanned 405 (let ((term (elt scanned 0)) 406 (defn (elt scanned (1- (length scanned))))) 407 (add-alias term defn) 408 "OK, done.") 409 (progn 410 (setf first-pass (regex-replace-all "(:|/|\\\\|\\#)" first-pass "")) 411 (when (and (scan "^(?i)lisppaste(\\s|!|\\?|\\.|$)*" first-pass) 412 (find-package :lisppaste) 413 channel 414 (> (length channel) 0) 415 (char= (elt channel 0) #\#) 416 (funcall (intern "SAY-HELP" :lisppaste) 417 channel)) 418 (return-from cliki-lookup nil)) 419 (or 420 (let ((strings 421 (nth-value 1 (scan-to-strings "^(?i)(direct|tell|show|inform|teach)\\s+(\\S+)\\s+(about|on|in|to|through|)\\s*(.+)$" first-pass)))) 422 (if strings 423 (let ((about (cliki-lookup (elt strings 3) :sender sender 424 :channel channel))) 425 (if about 426 (format nil "~A: ~A~A" 427 (elt strings 1) 428 (if (scan "http:" about) 429 (concatenate 'string 430 (random-element 431 '("have a look at" 432 "please look at" 433 "please see" 434 "direct your attention towards" 435 "look at")) 436 " ") 437 "") 438 about) 439 (setf should-send-cant-find nil))))) 440 (if (string-equal first-pass "help") 441 (if (should-do-lookup first-pass (or channel sender "")) 442 (progn 443 (did-lookup first-pass (or channel sender "")) 444 (cliki-bot-help *cliki-nickname*)) 445 (setf should-send-cant-find nil))) 446 (let ((strings (nth-value 1 (scan-to-strings "^(?i)help\\s+(on|about|to|describing|)\\s*\"*([^\"]+)\"*$" first-pass)))) 447 (if strings 448 (if 449 (should-do-lookup first-pass (or channel sender "")) 450 (progn 451 (did-lookup first-pass (or channel sender "")) 452 (cliki-find-help (elt strings 1))) 453 (setf should-send-cant-find nil)))) 454 (let ((strings (nth-value 1 (scan-to-strings "^(?i)(memo|note)\\s+(for|to)\\s+(\\S+)\\s*[:,]+\\s+(.+)$" term-with-question)))) 455 (when (and sender strings) 456 (if (string-equal (without-non-alphanumeric 457 (elt strings 2)) 458 (without-non-alphanumeric 459 *cliki-nickname*)) 460 "Buzz off." 461 (progn 462 (add-memo 463 sender 464 (if (member (elt strings 2) '("self" "myself" "me") :test #'string-equal) 465 sender 466 (elt strings 2)) 467 (elt strings 3)) 468 (format nil "Remembered. I'll tell ~A when he/she/it next speaks." (elt strings 2)))))) 469 (when (and sender 470 (scan "^(?i)(discard|forget)\\s+(my\\s+|)memo(s|)$" first-pass)) 471 (let ((count (remove-memos sender))) 472 (case count 473 (0 "You didn't have any memos!") 474 (1 "OK, I threw it out.") 475 (t "OK, I threw them out.")))) 476 (let ((strings (nth-value 1 (scan-to-strings "^(?i)(discard|forget)\\s+(my\\s+|)memo(s|)\\s+from\\s+([^ .]+)\\.*$" first-pass)))) 477 (when (and sender 478 strings) 479 (let ((count (remove-memos sender :from (elt strings 3)))) 480 (case count 481 (0 "You didn't have any memos!") 482 (1 "OK, I threw it out.") 483 (t "OK, I threw them out."))) 484 )) 485 (let ((to-forget (nth-value 1 (scan-to-strings "^forget\\s+([^.]+)\\.*$" first-pass)))) 486 (when to-forget 487 (forget (elt to-forget 0)) 488 (format nil "What's ~A? Never heard of it." (elt to-forget 0)))) 489 (let ((strs (nth-value 1 (scan-to-strings "^(?i)paste\\s+(\\d+)$" first-pass)))) 490 (and strs 491 (lookup-paste (parse-integer (elt strs 0))))) 492 493 (if (scan "^(?i)hello(\\s|$)*" first-pass) "what's up?") 494 (if (scan "^(?i)hi(\\s|$)*" first-pass) "what's up?") 495 (if (scan "^(?i)yo(\\s|$)*" first-pass) "what's up?") 496 (if (scan "^(?i)thank(s| you)(\\s|!|\\?|\\.|$)*" first-pass) 497 (if sender 498 (format nil "~A: you failed the inverse turing test!" sender) 499 "you failed the inverse turing test!")) 500 (if (scan "^(?i)version(\\s|!|\\?|\\.|$)*" first-pass) 501 (format nil "This is the minion bot, running on a ~A (~A) and running under ~A ~A." (machine-type) (machine-version) (lisp-implementation-type) (lisp-implementation-version))) 502 (if (scan "^(?i)(?i)do my bidding!*$" first-pass) "Yes, my master.") 503 (if (should-do-lookup first-pass (or channel sender "")) 504 (aif (or (small-definition-lookup first-pass) 505 (cliki-first-sentence first-pass) 506 (alias-lookup first-pass)) 507 (prog1 508 (concatenate 'string first-pass ": " it) 509 (did-lookup first-pass (or channel sender "")))) 510 (setf should-send-cant-find nil)) 511 (if (and 512 should-send-cant-find 513 (or 514 (scan "(!|\\.|\\s.+\\?|\\)|\\()\\s*$" term-with-question) 515 (scan "^\\s*\\S+\\s+\\S+.*$" term-with-question))) 516 ;;(generate-text (+ 20 (random 6))) 517 (progn 518 (setf should-send-cant-find nil) 519 (do-eliza first-pass)) 520 ) 521 (when should-send-cant-find 522 (format nil "Sorry, I couldn't find anything in the database for ``~A''.~A" first-pass (if (scan " " first-pass) " Maybe you meant to end with punctuation?" ""))) 523 )))))))) 524 417 525 (defun valid-cliki-message (message) 418 526 (scan *cliki-attention-prefix* (trailing-argument message))) … … 427 535 (defun msg-hook (message) 428 536 (let ((respond-to (if (string-equal (first (arguments message)) *cliki-nickname*) (source message) (first (arguments message))))) 429 (take-care-of-memos respond-to (source message))430 537 (if (valid-cliki-message message) 431 538 (let ((response (cliki-lookup (regex-replace *cliki-attention-prefix* (trailing-argument message) "") :sender (source message) :channel (first (irc:arguments message))))) … … 435 542 (privmsg *cliki-connection* respond-to it)) 436 543 (if (anybody-here (trailing-argument message)) 437 (privmsg *cliki-connection* (first (arguments message)) (format nil "~A: hello." (source message)))))))) 544 (privmsg *cliki-connection* (first (arguments message)) (format nil "~A: hello." (source message)))))) 545 (take-care-of-memos respond-to (source message)))) 438 546 439 547 (defvar *cliki-nickserv-password* "") -
TabularUnified trunk/example/specbot.lisp ¶
r47 r48 67 67 (defun add-simple-alist-lookup (file designator prefix description) 68 68 (let ((alist (with-open-file (s file :direction :input) (read s)))) 69 (push (cons designator alist) *alists*)69 (pushnew (cons designator alist) *alists* :test #'equal) 70 70 (setf *spec-providers* 71 71 (nconc *spec-providers* … … 115 115 (aif (strip-address to-lookup :address (second type) :final t) 116 116 (let ((looked-up (funcall actual-fun it))) 117 (if (and (< 0 (count #\space it) 3)117 (if (and (<= 0 (count #\space it) 1) 118 118 (not looked-up)) 119 119 (setf looked-up (format nil "Sorry, I couldn't find anything for ~A." it)))
Note: See TracChangeset
for help on using the changeset viewer.
