diff options
| author | aurelien <ice.cube@gmx.com> | 2011-08-03 12:55:15 +0200 |
|---|---|---|
| committer | aurelien <ice.cube@gmx.com> | 2011-08-03 12:55:15 +0200 |
| commit | 69e9d0d0d6df2f573d600ca7b2d6ca709004b832 (patch) | |
| tree | 8bcdad9839f84b6718e45770aca318cdaea3451a | |
first commit
77 files changed, 30213 insertions, 0 deletions
@@ -0,0 +1,1380 @@ +;; -*- emacs-lisp -*- + + (let ((buffer (url-retrieve-synchronously + "http://tromey.com/elpa/package-install.el"))) + (save-excursion + (set-buffer buffer) + (goto-char (point-min)) + (re-search-forward "^$" nil 'move) + (eval-region (point) (point-max)) + (kill-buffer (current-buffer)))) + +(setq erbot-nickserv-p t) + +(setq erc-prompt-for-nickserv-password nil) + +(setq erc-nickserv-passwords + '((freenode (("pbot" . "*"))))) + +(setq h4x0r-sometimes-replace + '(("ea" "33") ("er" "0r") ("a" "4") + ;;("b" "8") + ;;("d" "|>") + ("e" "3" "E") ;;("f" "|=") ("h" "|-|") + ;;("i" "1" "|") ;;("k" "|<" "x") + ;;("l" "1" "|_") ("m" "|\\/|") ("n" "|\\|") + ("o" "0") ;;("q" "@") + ("s" + "5" "Z" "$") + ;;("t" "+" "7") + ("ck" "x") ("u" "U") ;;("v" "\\/") + + ;("x" + ;X" "><") ("y" "j" + )) + +(add-to-list 'load-path "~/elisp") +(add-to-list 'load-path "~/elisp/erbot") +(add-to-list 'load-path "~/elisp/erbot/contrib/idledo") +(add-to-list 'load-path "~/elisp/erbot/erball") +(add-to-list 'load-path "~/elisp/erbot/erbbdb") +(add-to-list 'load-path "~/elisp/erbot/erbc2") +(add-to-list 'load-path "~/elisp/erbot/erbc3") +(add-to-list 'load-path "~/elisp/erbot/erbc4") +(add-to-list 'load-path "~/elisp/erbot/erbc5") +(add-to-list 'load-path "~/elisp/erbot/erbc6") +(add-to-list 'load-path "~/elisp/erbot/erbc-backquote") +(add-to-list 'load-path "~/elisp/erbot/erbc") +(add-to-list 'load-path "~/elisp/erbot/erbcompat") +(add-to-list 'load-path "~/elisp/erbot/erbcountry") +(add-to-list 'load-path "~/elisp/erbot/erbcspecial") +(add-to-list 'load-path "~/elisp/erbot/erbdata") +(add-to-list 'load-path "~/elisp/erbot/erbedit") +(add-to-list 'load-path "~/elisp/erbot/erbeng") +(add-to-list 'load-path "~/elisp/erbot/erbim") +(add-to-list 'load-path "~/elisp/erbot/erbkarma") +(add-to-list 'load-path "~/elisp/erbot/erblisp") +(add-to-list 'load-path "~/elisp/erbot/erblog") +(add-to-list 'load-path "~/elisp/erbot/erbmerge") +(add-to-list 'load-path "~/elisp/erbot/erbmsg") +(add-to-list 'load-path "~/elisp/erbot/erbp") +(add-to-list 'load-path "~/elisp/erbot/erbrss") +(add-to-list 'load-path "~/elisp/erbot/erbtrain") +(add-to-list 'load-path "~/elisp/erbot/erbunlisp") +(add-to-list 'load-path "~/elisp/erbot/erburl") +(add-to-list 'load-path "~/elisp/erbot/erbwiki") +(add-to-list 'load-path "~/elisp/erbot/contrib/faith") +(add-to-list 'load-path "~/elisp/erbot/contrib/flame") +(add-to-list 'load-path "~/elisp/erbot/contrib/geek") +(add-to-list 'load-path "~/elisp/erbot/contrib/h4x0r") +(add-to-list 'load-path "~/elisp/erbot/contrib/haiku") +(add-to-list 'load-path "~/elisp/erbot/contrib/lines") +(add-to-list 'load-path "~/elisp/erbot/contrib/mkback") +(add-to-list 'load-path "~/elisp/erbot/contrib/oct") +(add-to-list 'load-path "~/elisp/erbot/contrib/shs") +(add-to-list 'load-path "~/elisp/erbot/contrib/timerfunctions") +(add-to-list 'load-path "~/elisp/erbot/contrib/translate") +(add-to-list 'load-path "~/elisp/erbot/contrib/units") +(add-to-list 'load-path "~/elisp/erbot/contrib/wtf") + +(load "~/elisp/erbot/erbot.el") +(load "~/elisp/erbot/contrib/idledo.el") +(load "~/elisp/erbot/erball.el") +(load "~/elisp/erbot/erbbdb.el") +(load "~/elisp/erbot/erbc2.el") +(load "~/elisp/erbot/erbc3.el") +(load "~/elisp/erbot/erbc4.el") +(load "~/elisp/erbot/erbc5.el") +(load "~/elisp/erbot/erbc6.el") +(load "~/elisp/erbot/erbc-backquote.el") +(load "~/elisp/erbot/erbc.el") +(load "~/elisp/erbot/erbcompat.el") +(load "~/elisp/erbot/erbcountry.el") +(load "~/elisp/erbot/erbcspecial.el") +(load "~/elisp/erbot/erbdata.el") +(load "~/elisp/erbot/erbedit.el") +(load "~/elisp/erbot/erbeng.el") +(load "~/elisp/erbot/erbim.el") +(load "~/elisp/erbot/erbkarma.el") +(load "~/elisp/erbot/erblisp.el") +(load "~/elisp/erbot/erblog.el") +(load "~/elisp/erbot/erbmerge.el") +(load "~/elisp/erbot/erbmsg.el") +(load "~/elisp/erbot/erbp.el") +(load "~/elisp/erbot/erbrss.el") +(load "~/elisp/erbot/erbtrain.el") +(load "~/elisp/erbot/erbunlisp.el") +(load "~/elisp/erbot/erburl.el") +(load "~/elisp/erbot/erbwiki.el") +(load "~/elisp/erbot/contrib/faith.el") +(load "~/elisp/erbot/contrib/flame.el") +(load "~/elisp/erbot/contrib/geek.el") +(load "~/elisp/erbot/contrib/h4x0r.el") +(load "~/elisp/erbot/contrib/haiku.el") +(load "~/elisp/erbot/contrib/lines.el") +(load "~/elisp/erbot/contrib/mkback.el") +(load "~/elisp/erbot/contrib/oct.el") +(load "~/elisp/erbot/contrib/shs.el") +(load "~/elisp/erbot/contrib/timerfunctions.el") +(load "~/elisp/erbot/contrib/translate.el") +(load "~/elisp/erbot/contrib/units.el") +(load "~/elisp/erbot/contrib/wtf.el") + +(setq erc-keywords '("pbot" "parabola")) + +(setq fs-internal-english-weights + + '( + 30 ; doctor --- + 30 ; yow + 30 ; fortune + 2 ;; flame + )) + +(setq fs-internal-botito-mode nil) + +(setq fs-web-page-title-p t) + +;; this optional step +;; helps the bot get the locations of the .el files in emacs +(let ((aa default-directory)) + (cd "/usr/share/emacs/site-lisp") + (normal-top-level-add-subdirs-to-load-path) + (cd aa)) + +(require 'cl) +(setq erc-port 6667) +(require 'erc) +(require 'erc-match) +(require 'erc-track) +(require 'erball) +(require 'erburl) +(add-hook 'erc-mode-hook + '(lambda () (interactive) + (require 'erc-match) + (erc-match-mode 1) + (erc-match-enable) + (require 'erc-button) + (erc-button-enable) + nil + )) + + + (require 'erburl) + (erburl-scrape-terms + "http://www.emacswiki.org/cgi-bin/wiki?action=index") + (require 'erburl) + (erburl-scrape-terms + "http://wiki.parabolagnulinux.org") + (require 'erburl) + (erburl-scrape-terms + "https://bugs.parabolagnulinux.org/bugs/index") + (require 'erburl) + (erburl-scrape-terms + "http://libreplanet.org/wiki/Main_Page") + (require 'erburl) + (erburl-scrape-terms + "https://wiki.archlinux.org/index.php/Main_Page") + (require 'erburl) + (erburl-scrape-terms + "http://savannah.gnu.org/") + (require 'erburl) + (erburl-scrape-terms + "http://search.cpan.org/") + +;;(setq erbmsg-functions-p t) + +(setq erbot-erbmsg-p t) + +(setq erbn-url-functions-p t) + +(setq erbot-paranoid-p nil) + +(setq bbdb-file "~/pub/data/botbbdb") + +(setq erbot-servers-channels-test + '(("irc.freenode.net" + ("#." + ) + 6667 ;; this is the port, optional, can be omitted. + ) + + )) + + + + +(erbot-install) + + + +(add-hook 'erc-server-376-hook + '(lambda (&rest args) + (interactive) + (erc-track-modified-channels-mode 1) + nil)) + +(global-unset-key "\C-cs") + +(global-set-key "\C-cj " 'erbot-join-servers) +(global-set-key [f9 f1] 'erbot-join-servers) + +(global-unset-key [f6]) +(global-set-key [f6 f6] 'erblog-show-targets) +(global-set-key [f6 f7] 'erblog-reset-targets) +(global-set-key "\C-c\C-c" 'erc-send-current-line) + + +(global-set-key "\C-cr" 'erblog-reset-targets) + + + +(setq fsi-m8b-p t) + + + +;;(setq fs-limit-line-length 125) + + +;;(setq fs-limit-length + ;; 410) + +;;(setq fs-limit-lines 5 ) + +(setq bbdb-case-fold-search t) +(setq erc-auto-query t) + +;; Don't send more than 5 messages in 10 seconds. This prevents the +;; bot from getting kicked. +(setq erc-server-flood-penalty 2) +(setq erc-server-flood-margin 10) + +;; To restrict "automated" replies, change the "" below to your +;; favorite channels, example: +;;"\\(mychannel1\\|mychannel2\\)" +(setq fs-internal-query-target-regexp "") + +(setq fs-internal-google-level 60) + +(setq erbkarma-file "~/public_html/karma/karma") +(setq fs-internal-google-time 4) +(setq fs-internal-dictionary-time 4) + +(load "~/.emacs.private") + + +(setq erbkarma-tgt-check-string + "^\\(#parabola\\)$") + +;; .emacs ends here.. + + + + +(setq erbot-nick "pbot") +(setq erc-user-full-name "parabola") + +(setq erbot-servers-channels-main + '(("irc.freenode.net" + ("#." + )) + + )) + +(setq erbot-servers-channels erbot-servers-channels-main) + + +(setq fs-google-level 60) + + +(setq erbot-servers-channels-test + '(("irc.freenode.net" + ("#." + )) + + )) + +(setq bbdb-file-coding-system 'raw-text) +(require 'erball) +(erbunlisp-install) + +;; this delysid's server containing many dictionaries, if you prefer +;; the default server dict.org, just comment out this line. +(setq dictionary-server "dict.tu-graz.ac.at") + + +(fs-pf-load) +(fs-pv-load) + +(ignore-errors + (fs-user-init)) + +(require 'idledo) +(idledo-add-periodic-action-crude + '(fs-pv-save)) + +(add-hook 'kill-emacs-hook + 'fs-pv-save) + +;; consider uncommenting these +(add-to-list 'erblisp-allowed-words '&optional) +(add-to-list 'erblisp-allowed-words '&rest) + + +;;uncomment this only for a channel full of emacs hackers... see C-h v +(setq fs-internal-parse-error-p t) + +(setq units-dat-file "/usr/share/misc/units.dat") + +(add-to-list 'load-path "~/public_html/data") + + + +;; .emacs ends here.. +(custom-set-variables + ;; custom-set-variables was added by Custom. + ;; If you edit it by hand, you could mess it up, so be careful. + ;; Your init file should contain only one such instance. + ;; If there is more than one, they won't work right. + '(erc-email-userid "bot") + '(erc-user-full-name "Parabola GNU / Linux-Libre")) +(custom-set-faces + ;; custom-set-faces was added by Custom. + ;; If you edit it by hand, you could mess it up, so be careful. + ;; Your init file should contain only one such instance. + ;; If there is more than one, they won't work right. + '(default ((t (:inherit nil :stipple nil :background "unspecified-bg" :foreground "unspecified-fg" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :height 1 :width normal :foundry "default" :family "freemono"))))) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) + + +;;; This was installed by package-install.el. +;;; This provides support for the package system and +;;; interfacing with ELPA, the package archive. +;;; Move this code earlier if you want to reference +;;; packages in your .emacs. +(when + (load + (expand-file-name "~/.emacs.d/elpa/package.el")) + (package-initialize)) diff --git a/.emacs.d/auto-save-list/.saves-2372-bob.home~ b/.emacs.d/auto-save-list/.saves-2372-bob.home~ new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/.emacs.d/auto-save-list/.saves-2372-bob.home~ diff --git a/.emacs.d/elpa/package.el b/.emacs.d/elpa/package.el new file mode 100644 index 0000000..1cecbe3 --- /dev/null +++ b/.emacs.d/elpa/package.el @@ -0,0 +1,1507 @@ +;;; package.el --- Simple package system for Emacs + +;; Copyright (C) 2007, 2008, 2009 Tom Tromey <tromey@redhat.com> + +;; Author: Tom Tromey <tromey@redhat.com> +;; Created: 10 Mar 2007 +;; Version: 0.9 +;; Keywords: tools + +;; This file is not (yet) part of GNU Emacs. +;; However, it is distributed under the same license. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Change Log: + +;; 2 Apr 2007 - now using ChangeLog file +;; 15 Mar 2007 - updated documentation +;; 14 Mar 2007 - Changed how obsolete packages are handled +;; 13 Mar 2007 - Wrote package-install-from-buffer +;; 12 Mar 2007 - Wrote package-menu mode + +;;; Commentary: + +;; To use this, put package.el somewhere on your load-path. Then add +;; this to your .emacs: +;; +;; (load "package") +;; (package-initialize) +;; +;; This will automatically make available the packages you have +;; installed using package.el. If your .emacs will refer to these +;; packages, you may want to initialize the package manager near the +;; top. +;; +;; Note that if you want to be able to automatically download and +;; install packages from ELPA (the Emacs Lisp Package Archive), then +;; you will need the 'url' package. This comes with Emacs 22; Emacs +;; 21 users will have to find it elsewhere. +;; +;; If you installed package.el via the auto-installer: +;; +;; http://tromey.com/elpa/ +;; +;; then you do not need to edit your .emacs, as the installer will +;; have done this for you. The installer will also install the url +;; package if you need it. + +;; Other external functions you may want to use: +;; +;; M-x package-list-packages +;; Enters a mode similar to buffer-menu which lets you manage +;; packages. You can choose packages for install (mark with "i", +;; then "x" to execute) or deletion (not implemented yet), and you +;; can see what packages are available. This will automatically +;; fetch the latest list of packages from ELPA. +;; +;; M-x package-list-packages-no-fetch +;; Like package-list-packages, but does not automatically fetch the +;; new list of packages. +;; +;; M-x package-install-from-buffer +;; Install a package consisting of a single .el file that appears +;; in the current buffer. This only works for packages which +;; define a Version header properly; package.el also supports the +;; extension headers Package-Version (in case Version is an RCS id +;; or similar), and Package-Requires (if the package requires other +;; packages). +;; +;; M-x package-install-file +;; Install a package from the indicated file. The package can be +;; either a tar file or a .el file. A tar file must contain an +;; appropriately-named "-pkg.el" file; a .el file must be properly +;; formatted as with package-install-from-buffer. + +;; The idea behind package.el is to be able to download packages and +;; install them. Packages are versioned and have versioned +;; dependencies. Furthermore, this supports built-in packages which +;; may or may not be newer than user-specified packages. This makes +;; it possible to upgrade Emacs and automatically disable packages +;; which have moved from external to core. (Note though that we don't +;; currently register any of these, so this feature does not actually +;; work.) + +;; This code supports a single package repository, ELPA. All packages +;; must be registered there. + +;; A package is described by its name and version. The distribution +;; format is either a tar file or a single .el file. + +;; A tar file should be named "NAME-VERSION.tar". The tar file must +;; unpack into a directory named after the package and version: +;; "NAME-VERSION". It must contain a file named "PACKAGE-pkg.el" +;; which consists of a call to define-package. It may also contain a +;; "dir" file and the info files it references. + +;; A .el file will be named "NAME-VERSION.el" in ELPA, but will be +;; installed as simply "NAME.el" in a directory named "NAME-VERSION". + +;; The downloader will download all dependent packages. It will also +;; byte-compile the package's lisp at install time. + +;; At activation time we will set up the load-path and the info path, +;; and we will load the package's autoloads. If a package's +;; dependencies are not available, we will not activate that package. + +;; Conceptually a package has multiple state transitions: +;; +;; * Download. Fetching the package from ELPA. +;; * Install. Untar the package, or write the .el file, into +;; ~/.emacs.d/elpa/ directory. +;; * Byte compile. Currently this phase is done during install, +;; but we may change this. +;; * Activate. Evaluate the autoloads for the package to make it +;; available to the user. +;; * Load. Actually load the package and run some code from it. + +;;; Thanks: +;;; (sorted by sort-lines): + +;; Jim Blandy <jimb@red-bean.com> +;; Karl Fogel <kfogel@red-bean.com> +;; Kevin Ryde <user42@zip.com.au> +;; Lawrence Mitchell +;; Michael Olson <mwolson@member.fsf.org> +;; Sebastian Tennant <sebyte@smolny.plus.com> +;; Stefan Monnier <monnier@iro.umontreal.ca> +;; Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Phil Hagelberg <phil@hagelb.org> + +;;; ToDo: + +;; - putting info dirs at the start of the info path means +;; users see a weird ordering of categories. OTOH we want to +;; override later entries. maybe emacs needs to enforce +;; the standard layout? +;; - put bytecode in a separate directory tree +;; - perhaps give users a way to recompile their bytecode +;; or do it automatically when emacs changes +;; - give users a way to know whether a package is installed ok +;; - give users a way to view a package's documentation when it +;; only appears in the .el +;; - use/extend checkdoc so people can tell if their package will work +;; - "installed" instead of a blank in the status column +;; - tramp needs its files to be compiled in a certain order. +;; how to handle this? fix tramp? +;; - on emacs 21 we don't kill the -autoloads.el buffer. what about 22? +;; - maybe we need separate .elc directories for various emacs versions +;; and also emacs-vs-xemacs. That way conditional compilation can +;; work. But would this break anything? +;; - should store the package's keywords in archive-contents, then +;; let the users filter the package-menu by keyword. See +;; finder-by-keyword. (We could also let people view the +;; Commentary, but it isn't clear how useful this is.) +;; - William Xu suggests being able to open a package file without +;; installing it +;; - Interface with desktop.el so that restarting after an install +;; works properly +;; - Implement M-x package-upgrade, to upgrade any/all existing packages +;; - Use hierarchical layout. PKG/etc PKG/lisp PKG/info +;; ... except maybe lisp? +;; - It may be nice to have a macro that expands to the package's +;; private data dir, aka ".../etc". Or, maybe data-directory +;; needs to be a list (though this would be less nice) +;; a few packages want this, eg sokoban +;; - package menu needs: +;; ability to know which packages are built-in & thus not deletable +;; it can sometimes print odd results, like 0.3 available but 0.4 active +;; why is that? +;; - Allow multiple versions on the server...? +;; [ why bother? ] +;; - Don't install a package which will invalidate dependencies overall +;; - Allow something like (or (>= emacs 21.0) (>= xemacs 21.5)) +;; [ currently thinking, why bother.. KISS ] +;; - Allow optional package dependencies +;; then if we require 'bbdb', bbdb-specific lisp in lisp/bbdb +;; and just don't compile to add to load path ...? +;; - Have a list of archive URLs? [ maybe there's no point ] +;; - David Kastrup pointed out on the xemacs list that for GPL it +;; is friendlier to ship the source tree. We could "support" that +;; by just having a "src" subdir in the package. This isn't ideal +;; but it probably is not worth trying to support random source +;; tree layouts, build schemes, etc. +;; - Our treatment of the info path is somewhat bogus +;; - perhaps have an "unstable" tree in ELPA as well as a stable one + +;;; Code: + +(defconst package-archive-base "http://tromey.com/elpa/" + "Base URL for the package archive. +Ordinarily you should not need to edit this. +The default points to ELPA, the Emacs Lisp Package Archive. +Note that some code in package.el assumes that this is an http: URL.") + +(defconst package-archive-version 1 + "Version number of the package archive understood by this file. +Lower version numbers than this will probably be understood as well.") + +;; Note that this only works if you have the password, which you +;; probably don't :-). Also if you are using Emacs 21 then you will +;; need to hack ange-ftp-name-format to make this work. +(defvar package-archive-upload-base "/elpa@tromey.com@tromey.com:/" + "Base location for uploading to package archive.") + +(defconst package-el-maintainer "Tom Tromey <elpa@tromey.com>" + "The package.el maintainer.") + +(defconst package-el-version "0.9" + "Version of package.el.") + +;; We don't prime the cache since it tends to get out of date. +(defvar package-archive-contents + nil + "A representation of the contents of the ELPA archive. +This is an alist mapping package names (symbols) to package +descriptor vectors. These are like the vectors for `package-alist' +but have an extra entry which is 'tar for tar packages and +'single for single-file packages.") + +(defvar package-user-dir + (expand-file-name (convert-standard-filename "~/.emacs.d/elpa")) + "Name of the directory where the user's packages are stored.") + +(defvar package-directory-list + (list (file-name-as-directory package-user-dir) + "/usr/share/emacs/site-lisp/elpa/") + "List of directories to search for packages.") + +(defun package-version-split (string) + "Split a package string into a version list." + (mapcar 'string-to-int (split-string string "[.]"))) + +(defconst package--builtins-base + ;; We use package-version split here to make sure to pick up the + ;; minor version. + `((emacs . [,(package-version-split emacs-version) nil + "GNU Emacs"]) + (package . [,(package-version-split package-el-version) + nil "Simple package system for GNU Emacs"])) + "Packages which are always built-in.") + +(defvar package--builtins + (delq nil + (append + package--builtins-base + (if (>= emacs-major-version 22) + ;; FIXME: emacs 22 includes tramp, rcirc, maybe + ;; other things... + '((erc . [(5 2) nil "An Emacs Internet Relay Chat client"]) + ;; The external URL is version 1.15, so make sure the + ;; built-in one looks newer. + (url . [(1 16) nil "URL handling libary"]))) + (if (>= emacs-major-version 23) + '(;; Strangely, nxml-version is missing in Emacs 23. + ;; We pick the merge date as the version. + (nxml . [(20071123) nil "Major mode for editing XML documents."]) + (bubbles . [(0 5) nil "Puzzle game for Emacs."]))))) + "Alist of all built-in packages. +Maps the package name to a vector [VERSION REQS DOCSTRING].") + +(defvar package-alist package--builtins + "Alist of all packages available for activation. +Maps the package name to a vector [VERSION REQS DOCSTRING].") + +(defvar package-activated-list + (mapcar #'car package-alist) + "List of the names of all activated packages.") + +(defvar package-obsolete-alist nil + "Representation of obsolete packages. +Like `package-alist', but maps package name to a second alist. +The inner alist is keyed by version.") + +(defun package-version-join (l) + "Turn a list of version numbers into a version string." + (mapconcat 'int-to-string l ".")) + +(defun package--version-first-nonzero (l) + (while (and l (= (car l) 0)) + (setq l (cdr l))) + (if l (car l) 0)) + +(defun package-version-compare (v1 v2 fun) + "Compare two version lists according to FUN. +FUN can be <, <=, =, >, >=, or /=." + (while (and v1 v2 (= (car v1) (car v2))) + (setq v1 (cdr v1) + v2 (cdr v2))) + (if v1 + (if v2 + ;; Both not null; we know the cars are not =. + (funcall fun (car v1) (car v2)) + ;; V1 not null, V2 null. + (funcall fun (package--version-first-nonzero v1) 0)) + (if v2 + ;; V1 null, V2 not null. + (funcall fun 0 (package--version-first-nonzero v2)) + ;; Both null. + (funcall fun 0 0)))) + +(defun package--test-version-compare () + "Test suite for `package-version-compare'." + (unless (and (package-version-compare '(0) '(0) '=) + (not (package-version-compare '(1) '(0) '=)) + (package-version-compare '(1 0 1) '(1) '>=) + (package-version-compare '(1 0 1) '(1) '>) + (not (package-version-compare '(0 9 1) '(1 0 2) '>=))) + (error "Failed")) + t) + +(defun package-strip-version (dirname) + "Strip the version from a combined package name and version. +E.g., if given \"quux-23.0\", will return \"quux\"" + (if (string-match "^\\(.*\\)-[0-9]+\\([.][0-9]+\\)*$" dirname) + (match-string 1 dirname))) + +(defun package-load-descriptor (dir package) + "Load the description file for a package. +Return nil if the package could not be found." + (let ((pkg-dir (concat (file-name-as-directory dir) package "/"))) + (if (file-directory-p pkg-dir) + (load (concat pkg-dir (package-strip-version package) "-pkg") nil t)))) + +(defun package-load-all-descriptors () + "Load descriptors of all packages. +Uses `package-directory-list' to find packages." + (mapc (lambda (dir) + (if (file-directory-p dir) + (mapc (lambda (name) + (package-load-descriptor dir name)) + (directory-files dir nil "^[^.]")))) + package-directory-list)) + +(defsubst package-desc-vers (desc) + "Extract version from a package description vector." + (aref desc 0)) + +(defsubst package-desc-reqs (desc) + "Extract requirements from a package description vector." + (aref desc 1)) + +(defsubst package-desc-doc (desc) + "Extract doc string from a package description vector." + (aref desc 2)) + +(defsubst package-desc-kind (desc) + "Extract the kind of download from an archive package description vector." + (aref desc 3)) + +(defun package-do-activate (package pkg-vec) + (let* ((pkg-name (symbol-name package)) + (pkg-ver-str (package-version-join (package-desc-vers pkg-vec))) + (dir-list package-directory-list) + (pkg-dir)) + (while dir-list + (let ((subdir (concat (car dir-list) pkg-name "-" pkg-ver-str "/"))) + (if (file-directory-p subdir) + (progn + (setq pkg-dir subdir) + (setq dir-list nil)) + (setq dir-list (cdr dir-list))))) + (unless pkg-dir + (error "Internal error: could not find directory for %s-%s" + pkg-name pkg-ver-str)) + (if (file-exists-p (concat pkg-dir "dir")) + (progn + ;; FIXME: not the friendliest, but simple. + (require 'info) + (info-initialize) + (setq Info-directory-list (cons pkg-dir Info-directory-list)))) + (setq load-path (cons pkg-dir load-path)) + ;; Load the autoloads and activate the package. + (load (concat pkg-dir (symbol-name package) "-autoloads") + nil t) + (setq package-activated-list (cons package package-activated-list)) + ;; Don't return nil. + t)) + +(defun package--built-in (package version) + "Return true if the package is built-in to Emacs." + (let ((elt (assq package package--builtins))) + (and elt + (package-version-compare (package-desc-vers (cdr elt)) version '=)))) + +;; FIXME: return a reason instead? +(defun package-activate (package version) + "Try to activate a package. +Return nil if the package could not be activated. +Recursively activates all dependencies of the named package." + ;; Assume the user knows what he is doing -- go ahead and activate a + ;; newer version of a package if an older one has already been + ;; activated. This is not ideal; we'd at least need to check to see + ;; if the package has actually been loaded, and not merely + ;; activated. However, don't try to activate 'emacs', as that makes + ;; no sense. + (unless (eq package 'emacs) + (let* ((pkg-desc (assq package package-alist)) + (this-version (package-desc-vers (cdr pkg-desc))) + (req-list (package-desc-reqs (cdr pkg-desc))) + ;; If the package was never activated, we want to do it + ;; now. + (keep-going (or (not (memq package package-activated-list)) + (package-version-compare this-version version '>)))) + (while (and req-list keep-going) + (or (package-activate (car (car req-list)) + (car (cdr (car req-list)))) + (setq keep-going nil)) + (setq req-list (cdr req-list))) + (if keep-going + (package-do-activate package (cdr pkg-desc)) + ;; We get here if a dependency failed to activate -- but we + ;; can also get here if the requested package was already + ;; activated. Return non-nil in the latter case. + (and (memq package package-activated-list) + (package-version-compare this-version version '>=)))))) + +(defun package-mark-obsolete (package pkg-vec) + "Put package on the obsolete list, if not already there." + (let ((elt (assq package package-obsolete-alist))) + (if elt + ;; If this obsolete version does not exist in the list, update + ;; it the list. + (unless (assoc (package-desc-vers pkg-vec) (cdr elt)) + (setcdr elt (cons (cons (package-desc-vers pkg-vec) pkg-vec) + (cdr elt)))) + ;; Make a new association. + (setq package-obsolete-alist + (cons (cons package (list (cons (package-desc-vers pkg-vec) + pkg-vec))) + package-obsolete-alist))))) + +;; (define-package "emacs" "21.4.1" "GNU Emacs core package.") +;; (define-package "erc" "5.1" "ERC - irc client" '((emacs "21.0"))) +(defun define-package (name-str version-string + &optional docstring requirements) + "Define a new package. +NAME is the name of the package, a string. +VERSION-STRING is the version of the package, a dotted sequence +of integers. +DOCSTRING is the optional description. +REQUIREMENTS is a list of requirements on other packages. +Each requirement is of the form (OTHER-PACKAGE \"VERSION\")." + (let* ((name (intern name-str)) + (pkg-desc (assq name package-alist)) + (new-version (package-version-split version-string)) + (new-pkg-desc + (cons name + (vector new-version + (mapcar + (lambda (elt) + (list (car elt) + (package-version-split (car (cdr elt))))) + requirements) + docstring)))) + ;; Only redefine a package if the redefinition is newer. + (if (or (not pkg-desc) + (package-version-compare new-version + (package-desc-vers (cdr pkg-desc)) + '>)) + (progn + (when pkg-desc + ;; Remove old package and declare it obsolete. + (setq package-alist (delq pkg-desc package-alist)) + (package-mark-obsolete (car pkg-desc) (cdr pkg-desc))) + ;; Add package to the alist. + (setq package-alist (cons new-pkg-desc package-alist))) + ;; You can have two packages with the same version, for instance + ;; one in the system package directory and one in your private + ;; directory. We just let the first one win. + (unless (package-version-compare new-version + (package-desc-vers (cdr pkg-desc)) + '=) + ;; The package is born obsolete. + (package-mark-obsolete (car new-pkg-desc) (cdr new-pkg-desc)))))) + +;; From Emacs 22. +(defun package-autoload-ensure-default-file (file) + "Make sure that the autoload file FILE exists and if not create it." + (unless (file-exists-p file) + (write-region + (concat ";;; " (file-name-nondirectory file) + " --- automatically extracted autoloads\n" + ";;\n" + ";;; Code:\n\n" + " \n;; Local Variables:\n" + ";; version-control: never\n" + ";; no-byte-compile: t\n" + ";; no-update-autoloads: t\n" + ";; End:\n" + ";;; " (file-name-nondirectory file) + " ends here\n") + nil file)) + file) + +(defun package-generate-autoloads (name pkg-dir) + (let* ((auto-name (concat name "-autoloads.el")) + (ignore-name (concat name "-pkg.el")) + (generated-autoload-file (concat pkg-dir auto-name)) + (version-control 'never)) + ;; In Emacs 22 'update-autoloads-from-directories' does not seem + ;; to be autoloaded... + (require 'autoload) + (unless (fboundp 'autoload-ensure-default-file) + (package-autoload-ensure-default-file generated-autoload-file)) + (update-autoloads-from-directories pkg-dir))) + +(defun package-untar-buffer () + "Untar the current buffer. +This uses `tar-untar-buffer' if it is available. +Otherwise it uses an external `tar' program. +`default-directory' should be set by the caller." + (require 'tar-mode) + (if (fboundp 'tar-untar-buffer) + (progn + ;; tar-mode messes with narrowing, so we just let it have the + ;; whole buffer to play with. + (delete-region (point-min) (point)) + (tar-mode) + (tar-untar-buffer)) + ;; FIXME: check the result. + (call-process-region (point) (point-max) "tar" nil '(nil nil) nil + "xf" "-"))) + +(defun package-unpack (name version) + (let ((pkg-dir (concat (file-name-as-directory package-user-dir) + (symbol-name name) "-" version "/"))) + ;; Be careful!! + (make-directory package-user-dir t) + (if (file-directory-p pkg-dir) + (mapc (lambda (file) nil) ; 'delete-file -- FIXME: when we're + ; more confident + (directory-files pkg-dir t "^[^.]"))) + (let* ((default-directory (file-name-as-directory package-user-dir))) + (package-untar-buffer) + (package-generate-autoloads (symbol-name name) pkg-dir) + (let ((load-path (cons pkg-dir load-path))) + (byte-recompile-directory pkg-dir 0 t))))) + +(defun package-unpack-single (file-name version desc requires) + "Install the contents of the current buffer as a package." + (let* ((dir (file-name-as-directory package-user-dir))) + ;; Special case "package". + (if (string= file-name "package") + (write-region (point-min) (point-max) (concat dir file-name ".el") + nil nil nil nil) + (let ((pkg-dir (file-name-as-directory + (concat dir file-name "-" version)))) + (make-directory pkg-dir t) + (write-region (point-min) (point-max) + (concat pkg-dir file-name ".el") + nil nil nil 'excl) + (let ((print-level nil) + (print-length nil)) + (write-region + (concat + (prin1-to-string + (list 'define-package + file-name + version + desc + (list 'quote + ;; Turn version lists into string form. + (mapcar + (lambda (elt) + (list (car elt) + (package-version-join (car (cdr elt))))) + requires)))) + "\n") + nil + (concat pkg-dir file-name "-pkg.el") + nil nil nil 'excl)) + (package-generate-autoloads file-name pkg-dir) + (let ((load-path (cons pkg-dir load-path))) + (byte-recompile-directory pkg-dir 0 t)))))) + +(defun package-handle-response () + "Handle the response from the server. +Parse the HTTP response and throw if an error occurred. +The url package seems to require extra processing for this. +This should be called in a `save-excursion', in the download buffer. +It will move point to somewhere in the headers." + ;; We assume HTTP here. + (let ((response (url-http-parse-response))) + (when (or (< response 200) (>= response 300)) + (display-buffer (current-buffer)) + (error "Error during download request:%s" + (buffer-substring-no-properties (point) (progn + (end-of-line) + (point))))))) + +(defun package-download-single (name version desc requires) + "Download and install a single-file package." + (let ((buffer (url-retrieve-synchronously + (concat package-archive-base + (symbol-name name) "-" version ".el")))) + (save-excursion + (set-buffer buffer) + (package-handle-response) + (re-search-forward "^$" nil 'move) + (forward-char) + (delete-region (point-min) (point)) + (package-unpack-single (symbol-name name) version desc requires) + (kill-buffer buffer)))) + +(defun package-download-tar (name version) + "Download and install a tar package." + (let ((tar-buffer (url-retrieve-synchronously + (concat package-archive-base + (symbol-name name) "-" version ".tar")))) + (save-excursion + (set-buffer tar-buffer) + (package-handle-response) + (re-search-forward "^$" nil 'move) + (forward-char) + (package-unpack name version) + (kill-buffer tar-buffer)))) + +(defun package-installed-p (package version) + (let ((pkg-desc (assq package package-alist))) + (and pkg-desc + (package-version-compare version + (package-desc-vers (cdr pkg-desc)) + '>=)))) + +(defun package-compute-transaction (result requirements) + (while requirements + (let* ((elt (car requirements)) + (next-pkg (car elt)) + (next-version (car (cdr elt)))) + (unless (package-installed-p next-pkg next-version) + (let ((pkg-desc (assq next-pkg package-archive-contents))) + (unless pkg-desc + (error "Package '%s' not available for installation" + (symbol-name next-pkg))) + (unless (package-version-compare (package-desc-vers (cdr pkg-desc)) + next-version + '>=) + (error + "Need package '%s' with version %s, but only %s is available" + (symbol-name next-pkg) (package-version-join next-version) + (package-version-join (package-desc-vers (cdr pkg-desc))))) + ;; Only add to the transaction if we don't already have it. + (unless (memq next-pkg result) + (setq result (cons next-pkg result))) + (setq result + (package-compute-transaction result + (package-desc-reqs + (cdr pkg-desc))))))) + (setq requirements (cdr requirements))) + result) + +(defun package-read-from-string (str) + "Read a Lisp expression from STR. +Signal an error if the entire string was not used." + (let* ((read-data (read-from-string str)) + (more-left + (condition-case nil + ;; The call to `ignore' suppresses a compiler warning. + (progn (ignore (read-from-string + (substring str (cdr read-data)))) + t) + (end-of-file nil)))) + (if more-left + (error "Can't read whole string") + (car read-data)))) + +(defun package--read-archive-file (file) + "Re-read archive file FILE, if it exists. +Will return the data from the file, or nil if the file does not exist. +Will throw an error if the archive version is too new." + (let ((filename (concat (file-name-as-directory package-user-dir) + file))) + (if (file-exists-p filename) + (with-temp-buffer + (insert-file-contents-literally filename) + (let ((contents (package-read-from-string + (buffer-substring-no-properties (point-min) + (point-max))))) + (if (> (car contents) package-archive-version) + (error "Package archive version %d is greater than %d - upgrade package.el" + (car contents) package-archive-version)) + (cdr contents)))))) + +(defun package-read-archive-contents () + "Re-read `archive-contents' and `builtin-packages', if they exist. +Will set `package-archive-contents' and `package--builtins' if successful. +Will throw an error if the archive version is too new." + (let ((archive-contents (package--read-archive-file "archive-contents")) + (builtins (package--read-archive-file "builtin-packages"))) + (if archive-contents + ;; Version 1 of 'archive-contents' is identical to our + ;; internal representation. + (setq package-archive-contents archive-contents)) + (if builtins + ;; Version 1 of 'builtin-packages' is a list where the car is + ;; a split emacs version and the cdr is an alist suitable for + ;; package--builtins. + (let ((our-version (package-version-split emacs-version)) + (result package--builtins-base)) + (setq package--builtins + (dolist (elt builtins result) + (if (package-version-compare our-version (car elt) '>=) + (setq result (append (cdr elt) result))))))))) + +(defun package-download-transaction (transaction) + "Download and install all the packages in the given transaction." + (mapc (lambda (elt) + (let* ((desc (cdr (assq elt package-archive-contents))) + (v-string (package-version-join (package-desc-vers desc))) + (kind (package-desc-kind desc))) + (cond + ((eq kind 'tar) + (package-download-tar elt v-string)) + ((eq kind 'single) + (package-download-single elt v-string + (package-desc-doc desc) + (package-desc-reqs desc))) + (t + (error "Unknown package kind: " (symbol-name kind)))))) + transaction)) + +(defun package-install (name) + "Install the package named NAME. +Interactively, prompts for the package name. +The package is found on the archive site, see `package-archive-base'." + (interactive + (list (progn + ;; Make sure we're using the most recent download of the + ;; archive. Maybe we should be updating the archive first? + (package-read-archive-contents) + (intern (completing-read "Install package: " + (mapcar (lambda (elt) + (cons (symbol-name (car elt)) + nil)) + package-archive-contents) + nil t))))) + (let ((pkg-desc (assq name package-archive-contents))) + (unless pkg-desc + (error "Package '%s' not available for installation" + (symbol-name name))) + (let ((transaction + (package-compute-transaction (list name) + (package-desc-reqs (cdr pkg-desc))))) + (package-download-transaction transaction))) + ;; Try to activate it. + (package-initialize)) + +(defun package-strip-rcs-id (v-str) + "Strip RCS version ID from the version string. +If the result looks like a dotted numeric version, return it. +Otherwise return nil." + (if v-str + (if (string-match "^[ \t]*[$]Revision:[ \t]\([0-9.]+\)[ \t]*[$]$" v-str) + (match-string 1 v-str) + (if (string-match "^[0-9.]*$" v-str) + v-str)))) + +(defun package-buffer-info () + "Return a vector of information about the package in the current buffer. +The vector looks like [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY] +FILENAME is the file name, a string. It does not have the \".el\" extension. +REQUIRES is a requires list, or nil. +DESCRIPTION is the package description (a string). +VERSION is the version, a string. +COMMENTARY is the commentary section, a string, or nil if none. +Throws an exception if the buffer does not contain a conforming package. +If there is a package, narrows the buffer to the file's boundaries. +May narrow buffer or move point even on failure." + (goto-char (point-min)) + (if (re-search-forward "^;;; \\([^ ]*\\)\\.el --- \\(.*\\)$" nil t) + (let ((file-name (match-string 1)) + (desc (match-string 2)) + (start (progn (beginning-of-line) (point)))) + (if (search-forward (concat ";;; " file-name ".el ends here")) + (progn + ;; Try to include a trailing newline. + (forward-line) + (narrow-to-region start (point)) + (require 'lisp-mnt) + ;; Use some headers we've invented to drive the process. + (let* ((requires-str (lm-header "package-requires")) + (requires (if requires-str + (package-read-from-string requires-str))) + ;; Prefer Package-Version, because if it is + ;; defined the package author probably wants us + ;; to use it. Otherwise try Version. + (pkg-version + (or (package-strip-rcs-id (lm-header "package-version")) + (package-strip-rcs-id (lm-header "version")))) + (commentary (lm-commentary))) + (unless pkg-version + (error + "Package does not define a usable \"Version\" or \"Package-Version\" header")) + ;; Turn string version numbers into list form. + (setq requires + (mapcar + (lambda (elt) + (list (car elt) + (package-version-split (car (cdr elt))))) + requires)) + (set-text-properties 0 (length file-name) nil file-name) + (set-text-properties 0 (length pkg-version) nil pkg-version) + (set-text-properties 0 (length desc) nil desc) + (vector file-name requires desc pkg-version commentary))) + (error "Package missing a terminating comment"))) + (error "No starting comment for package"))) + +(defun package-tar-file-info (file) + "Find package information for a tar file. +FILE is the name of the tar file to examine. +The return result is a vector like `package-buffer-info'." + (unless (string-match "^\\(.+\\)-\\([0-9.]+\\)\\.tar$" file) + (error "`%s' doesn't have a package-ish name" file)) + (let* ((pkg-name (file-name-nondirectory (match-string-no-properties 1 file))) + (pkg-version (match-string-no-properties 2 file)) + ;; Extract the package descriptor. + (pkg-def-contents (shell-command-to-string + ;; Requires GNU tar. + (concat "tar -xOf " file " " + pkg-name "-" pkg-version "/" + pkg-name "-pkg.el"))) + (pkg-def-parsed (package-read-from-string pkg-def-contents))) + (unless (eq (car pkg-def-parsed) 'define-package) + (error "%s-pkg.el doesn't contain `define-package' sexp" pkg-name)) + (let ((name-str (nth 1 pkg-def-parsed)) + (version-string (nth 2 pkg-def-parsed)) + (docstring (nth 3 pkg-def-parsed)) + (requires (nth 4 pkg-def-parsed)) + + (readme (shell-command-to-string + ;; Requires GNU tar. + (concat "tar -xOf " file " " + pkg-name "-" pkg-version "/README")))) + (unless (equal pkg-version version-string) + (error "Inconsistent versions!")) + (unless (equal pkg-name name-str) + (error "Inconsistent names!")) + ;; Kind of a hack. + (if (string-match ": Not found in archive" readme) + (setq readme nil)) + ;; Turn string version numbers into list form. + (if (eq (car requires) 'quote) + (setq requires (car (cdr requires)))) + (setq requires + (mapcar + (lambda (elt) + (list (car elt) + (package-version-split (car (cdr elt))))) + requires)) + (vector pkg-name requires docstring version-string readme)))) + +(defun package-install-buffer-internal (pkg-info type) + (save-excursion + (save-restriction + (let* ((file-name (aref pkg-info 0)) + (requires (aref pkg-info 1)) + (desc (if (string= (aref pkg-info 2) "") + "No description available." + (aref pkg-info 2))) + (pkg-version (aref pkg-info 3))) + ;; Download and install the dependencies. + (let ((transaction (package-compute-transaction nil requires))) + (package-download-transaction transaction)) + ;; Install the package itself. + (cond + ((eq type 'single) + (package-unpack-single file-name pkg-version desc requires)) + ((eq type 'tar) + (package-unpack (intern file-name) pkg-version)) + (t + (error "Unknown type: %s" (symbol-name type)))) + ;; Try to activate it. + (package-initialize))))) + +(defun package-install-from-buffer () + "Install a package from the current buffer. +The package is assumed to be a single .el file which +follows the elisp comment guidelines; see +info node `(elisp)Library Headers'." + (interactive) + (package-install-buffer-internal (package-buffer-info) 'single)) + +(defun package-install-file (file) + "Install a package from a file. +The file can either be a tar file or an Emacs Lisp file." + (interactive "fPackage file name: ") + (with-temp-buffer + (insert-file-contents-literally file) + (cond + ((string-match "\\.el$" file) (package-install-from-buffer)) + ((string-match "\\.tar$" file) + (package-install-buffer-internal (package-tar-file-info file) 'tar)) + (t (error "Unrecognized extension `%s'" (file-name-extension file)))))) + +(defun package-delete (name version) + (require 'dired) ; for dired-delete-file + (dired-delete-file (concat (file-name-as-directory package-user-dir) + name "-" version) + ;; FIXME: query user? + 'always)) + +(defun package--encode (string) + "Encode a string by replacing some characters with XML entities." + ;; We need a special case for translating "&" to "&". + (let ((index)) + (while (setq index (string-match "[&]" string index)) + (setq string (replace-match "&" t nil string)) + (setq index (1+ index)))) + (while (string-match "[<]" string) + (setq string (replace-match "<" t nil string))) + (while (string-match "[>]" string) + (setq string (replace-match ">" t nil string))) + (while (string-match "[']" string) + (setq string (replace-match "'" t nil string))) + (while (string-match "[\"]" string) + (setq string (replace-match """ t nil string))) + string) + +(defun package--make-rss-entry (title text) + (let ((date-string (format-time-string "%a, %d %B %Y %T %z"))) + (concat "<item>\n" + "<title>" (package--encode title) "</title>\n" + ;; FIXME: should have a link in the web page. + "<link>" package-archive-base "news.html</link>\n" + "<description>" (package--encode text) "</description>\n" + "<pubDate>" date-string "</pubDate>\n" + "</item>\n"))) + +(defun package--make-html-entry (title text) + (concat "<li> " (format-time-string "%B %e") " - " + title " - " (package--encode text) + " </li>\n")) + +(defun package--update-file (file location text) + (save-excursion + (let ((old-buffer (find-buffer-visiting file))) + (with-current-buffer (let ((find-file-visit-truename t)) + (or old-buffer (find-file-noselect file))) + (goto-char (point-min)) + (search-forward location) + (forward-line) + (insert text) + (let ((file-precious-flag t)) + (save-buffer)) + (unless old-buffer + (kill-buffer (current-buffer))))))) + +(defun package-maint-add-news-item (title description) + "Add a news item to the ELPA web pages. +TITLE is the title of the news item. +DESCRIPTION is the text of the news item. +You need administrative access to ELPA to use this." + (interactive "sTitle: \nsText: ") + (package--update-file (concat package-archive-upload-base "elpa.rss") + "<description>" + (package--make-rss-entry title description)) + (package--update-file (concat package-archive-upload-base "news.html") + "New entries go here" + (package--make-html-entry title description))) + +(defun package--update-news (package version description) + "Update the ELPA web pages when a package is uploaded." + (package-maint-add-news-item (concat package " version " version) + description)) + +(defun package-upload-buffer-internal (pkg-info extension) + "Upload a package whose contents are in the current buffer. +PKG-INFO is the package info, see `package-buffer-info'. +EXTENSION is the file extension, a string. It can be either +\"el\" or \"tar\"." + (save-excursion + (save-restriction + (let* ((file-type (cond + ((equal extension "el") 'single) + ((equal extension "tar") 'tar) + (t (error "Unknown extension `%s'" extension)))) + (file-name (aref pkg-info 0)) + (pkg-name (intern file-name)) + (requires (aref pkg-info 1)) + (desc (if (string= (aref pkg-info 2) "") + (read-string "Description of package: ") + (aref pkg-info 2))) + (pkg-version (aref pkg-info 3)) + (commentary (aref pkg-info 4)) + (split-version (package-version-split pkg-version)) + (pkg-buffer (current-buffer)) + + ;; Download latest archive-contents. + (buffer (url-retrieve-synchronously + (concat package-archive-base "archive-contents")))) + + ;; Parse archive-contents. + (set-buffer buffer) + (package-handle-response) + (re-search-forward "^$" nil 'move) + (forward-char) + (delete-region (point-min) (point)) + (let ((contents (package-read-from-string + (buffer-substring-no-properties (point-min) + (point-max)))) + (new-desc (vector split-version requires desc file-type))) + (if (> (car contents) package-archive-version) + (error "Unrecognized archive version %d" (car contents))) + (let ((elt (assq pkg-name (cdr contents)))) + (if elt + (if (package-version-compare split-version + (package-desc-vers (cdr elt)) + '<=) + (error "New package has smaller version: %s" pkg-version) + (setcdr elt new-desc)) + (setq contents (cons (car contents) + (cons (cons pkg-name new-desc) + (cdr contents)))))) + + ;; Now CONTENTS is the updated archive contents. Upload + ;; this and the package itself. For now we assume ELPA is + ;; writable via file primitives. + (let ((print-level nil) + (print-length nil)) + (write-region (concat (pp-to-string contents) "\n") + nil + (concat package-archive-upload-base + "archive-contents"))) + + ;; If there is a commentary section, write it. + (when commentary + (write-region commentary nil + (concat package-archive-upload-base + (symbol-name pkg-name) "-readme.txt"))) + + (set-buffer pkg-buffer) + (kill-buffer buffer) + (write-region (point-min) (point-max) + (concat package-archive-upload-base + file-name "-" pkg-version + "." extension) + nil nil nil 'excl) + + ;; Write a news entry. + (package--update-news (concat file-name "." extension) + pkg-version desc) + + ;; special-case "package": write a second copy so that the + ;; installer can easily find the latest version. + (if (string= file-name "package") + (write-region (point-min) (point-max) + (concat package-archive-upload-base + file-name "." extension) + nil nil nil 'ask))))))) + +(defun package-upload-buffer () + "Upload a single .el file to ELPA from the current buffer." + (interactive) + (save-excursion + (save-restriction + ;; Find the package in this buffer. + (let ((pkg-info (package-buffer-info))) + (package-upload-buffer-internal pkg-info "el"))))) + +(defun package-upload-file (file) + (interactive "fPackage file name: ") + (with-temp-buffer + (insert-file-contents-literally file) + (let ((info (cond + ((string-match "\\.tar$" file) (package-tar-file-info file)) + ((string-match "\\.el$" file) (package-buffer-info)) + (t (error "Unrecognized extension `%s'" + (file-name-extension file)))))) + (package-upload-buffer-internal info (file-name-extension file))))) + +(defun package-gnus-summary-upload () + "Upload a package contained in the current *Article* buffer. +This should be invoked from the gnus *Summary* buffer." + (interactive) + (save-excursion + (set-buffer gnus-article-buffer) + (package-upload-buffer))) + +(defun package--download-one-archive (file) + "Download a single archive file and cache it locally." + (let ((buffer (url-retrieve-synchronously + (concat package-archive-base file)))) + (save-excursion + (set-buffer buffer) + (package-handle-response) + (re-search-forward "^$" nil 'move) + (forward-char) + (delete-region (point-min) (point)) + (setq buffer-file-name (concat (file-name-as-directory package-user-dir) + file)) + (let ((version-control 'never)) + (save-buffer)) + (kill-buffer buffer)))) + +(defun package-refresh-contents () + "Download the ELPA archive description if needed. +Invoking this will ensure that Emacs knows about the latest versions +of all packages. This will let Emacs make them available for +download." + (interactive) + (package--download-one-archive "archive-contents") + (package--download-one-archive "builtin-packages") + (package-read-archive-contents)) + +(defun package-initialize () + "Load all packages and activate as many as possible." + (setq package-obsolete-alist nil) + (package-load-all-descriptors) + (package-read-archive-contents) + ;; Try to activate all our packages. + (mapc (lambda (elt) + (package-activate (car elt) (package-desc-vers (cdr elt)))) + package-alist)) + + + +;;;; Package menu mode. + +(defvar package-menu-mode-map nil + "Local keymap for `package-menu-mode' buffers.") + +(unless package-menu-mode-map + (setq package-menu-mode-map (make-keymap)) + (suppress-keymap package-menu-mode-map) + (define-key package-menu-mode-map "q" 'quit-window) + (define-key package-menu-mode-map "n" 'next-line) + (define-key package-menu-mode-map "p" 'previous-line) + (define-key package-menu-mode-map "u" 'package-menu-mark-unmark) + (define-key package-menu-mode-map "\177" 'package-menu-backup-unmark) + (define-key package-menu-mode-map "d" 'package-menu-mark-delete) + (define-key package-menu-mode-map "i" 'package-menu-mark-install) + (define-key package-menu-mode-map "g" 'package-menu-revert) + (define-key package-menu-mode-map "r" 'package-menu-refresh) + (define-key package-menu-mode-map "~" + 'package-menu-mark-obsolete-for-deletion) + (define-key package-menu-mode-map "x" 'package-menu-execute) + (define-key package-menu-mode-map "h" 'package-menu-quick-help) + (define-key package-menu-mode-map "?" 'package-menu-view-commentary) + ) + +(defvar package-menu-sort-button-map + (let ((map (make-sparse-keymap))) + (define-key map [header-line mouse-1] 'package-menu-sort-by-column) + (define-key map [follow-link] 'mouse-face) + map) + "Local keymap for package menu sort buttons.") + +(put 'package-menu-mode 'mode-class 'special) + +(defun package-menu-mode () + "Major mode for browsing a list of packages. +Letters do not insert themselves; instead, they are commands. +\\<package-menu-mode-map> +\\{package-menu-mode-map}" + (kill-all-local-variables) + (use-local-map package-menu-mode-map) + (setq major-mode 'package-menu-mode) + (setq mode-name "Package Menu") + (setq truncate-lines t) + (setq buffer-read-only t) + ;; Support Emacs 21. + (if (fboundp 'run-mode-hooks) + (run-mode-hooks 'package-menu-mode-hook) + (run-hooks 'package-menu-mode-hook))) + +(defun package-menu-refresh () + "Download the ELPA archive. +This fetches the file describing the current contents of +the Emacs Lisp Package Archive, and then refreshes the +package menu. This lets you see what new packages are +available for download." + (interactive) + (package-refresh-contents) + (package-list-packages-internal)) + +(defun package-menu-revert () + "Update the list of packages." + (interactive) + (package-list-packages-internal)) + +(defun package-menu-mark-internal (what) + (unless (eobp) + (let ((buffer-read-only nil)) + (beginning-of-line) + (delete-char 1) + (insert what) + (forward-line)))) + +;; fixme numeric argument +(defun package-menu-mark-delete (num) + "Mark a package for deletion and move to the next line." + (interactive "p") + (package-menu-mark-internal "D")) + +(defun package-menu-mark-install (num) + "Mark a package for installation and move to the next line." + (interactive "p") + (package-menu-mark-internal "I")) + +(defun package-menu-mark-unmark (num) + "Clear any marks on a package and move to the next line." + (interactive "p") + (package-menu-mark-internal " ")) + +(defun package-menu-backup-unmark () + "Back up one line and clear any marks on that package." + (interactive) + (forward-line -1) + (package-menu-mark-internal " ") + (forward-line -1)) + +(defun package-menu-mark-obsolete-for-deletion () + "Mark all obsolete packages for deletion." + (interactive) + (save-excursion + (goto-char (point-min)) + (forward-line 2) + (while (not (eobp)) + (if (looking-at ".*\\s obsolete\\s ") + (package-menu-mark-internal "D") + (forward-line 1))))) + +(defun package-menu-quick-help () + "Show short key binding help for package-menu-mode." + (interactive) + (message "n-ext, i-nstall, d-elete, u-nmark, x-ecute, r-efresh, h-elp")) + +(defun package-menu-view-commentary () + "Display information about this package. +For single-file packages, shows the commentary section from the header. +For larger packages, shows the README file." + (interactive) + (let* (start-point ok + (pkg-name (package-menu-get-package)) + (buffer (url-retrieve-synchronously (concat package-archive-base + pkg-name + "-readme.txt")))) + (with-current-buffer buffer + ;; FIXME: it would be nice to work with any URL type. + (setq start-point url-http-end-of-headers) + (setq ok (eq (url-http-parse-response) 200))) + (let ((new-buffer (get-buffer-create "*Package Info*"))) + (with-current-buffer new-buffer + (let ((buffer-read-only nil)) + (erase-buffer) + (insert "Package information for " pkg-name "\n\n") + (if ok + (insert-buffer-substring buffer start-point) + (insert "This package does not have a README file or commentary comment.\n")) + (goto-char (point-min)) + (view-mode))) + (display-buffer new-buffer t)))) + +;; Return the name of the package on the current line. +(defun package-menu-get-package () + (save-excursion + (beginning-of-line) + (if (looking-at ". \\([^ \t]*\\)") + (match-string 1)))) + +;; Return the version of the package on the current line. +(defun package-menu-get-version () + (save-excursion + (beginning-of-line) + (if (looking-at ". [^ \t]*[ \t]*\\([0-9.]*\\)") + (match-string 1)))) + +(defun package-menu-get-status () + (save-excursion + (if (looking-at ". [^ \t]*[ \t]*[^ \t]*[ \t]*\\([^ \t]*\\)") + (match-string 1) + ""))) + +(defun package-menu-execute () + "Perform all the marked actions. +Packages marked for installation will be downloaded and +installed. Packages marked for deletion will be removed. +Note that after installing packages you will want to restart +Emacs." + (interactive) + (goto-char (point-min)) + (forward-line 2) + (while (not (eobp)) + (let ((cmd (char-after)) + (pkg-name (package-menu-get-package)) + (pkg-vers (package-menu-get-version)) + (pkg-status (package-menu-get-status))) + (cond + ((eq cmd ?D) + (when (and (string= pkg-status "installed") + (string= pkg-name "package")) + ;; FIXME: actually, we could be tricky and remove all info. + ;; But that is drastic and the user can do that instead. + (error "Can't delete most recent version of `package'")) + ;; Ask for confirmation here? Maybe if package status is ""? + ;; Or if any lisp from package is actually loaded? + (message "Deleting %s-%s..." pkg-name pkg-vers) + (package-delete pkg-name pkg-vers) + (message "Deleting %s-%s... done" pkg-name pkg-vers)) + ((eq cmd ?I) + (package-install (intern pkg-name))))) + (forward-line)) + (package-menu-revert)) + +(defun package-print-package (package version key desc) + (let ((face + (cond ((eq package 'emacs) 'font-lock-builtin-face) + ((string= key "available") 'default) + ((string= key "installed") 'font-lock-comment-face) + (t ; obsolete, but also the default. + ; is warning ok? + 'font-lock-warning-face)))) + (insert (propertize " " 'font-lock-face face)) + (insert (propertize (symbol-name package) 'font-lock-face face)) + (indent-to 20 1) + (insert (propertize (package-version-join version) 'font-lock-face face)) + (indent-to 30 1) + (insert (propertize key 'font-lock-face face)) + ;; FIXME: this 'when' is bogus... + (when desc + (indent-to 41 1) + (insert (propertize desc 'font-lock-face face))) + (insert "\n"))) + +(defun package-list-maybe-add (package version status description result) + (let ((elt (assoc (cons package version) result))) + (unless elt + (setq result (cons (list (cons package version) status description) + result)))) + result) + +;; This decides how we should sort; nil means by package name. +(defvar package-menu-sort-key nil) + +(defun package-list-packages-internal () + (package-initialize) ; FIXME: do this here? + (with-current-buffer (get-buffer-create "*Packages*") + (setq buffer-read-only nil) + (erase-buffer) + (let ((info-list)) + (mapc (lambda (elt) + (setq info-list + (package-list-maybe-add (car elt) + (package-desc-vers (cdr elt)) + ;; FIXME: it turns out to + ;; be tricky to see if + ;; this package is + ;; presently activated. + ;; That is lame! + "installed" + (package-desc-doc (cdr elt)) + info-list))) + package-alist) + (mapc (lambda (elt) + (setq info-list + (package-list-maybe-add (car elt) + (package-desc-vers (cdr elt)) + "available" + (package-desc-doc (cdr elt)) + info-list))) + package-archive-contents) + (mapc (lambda (elt) + (mapc (lambda (inner-elt) + (setq info-list + (package-list-maybe-add (car elt) + (package-desc-vers + (cdr inner-elt)) + "obsolete" + (package-desc-doc + (cdr inner-elt)) + info-list))) + (cdr elt))) + package-obsolete-alist) + (let ((selector (cond + ((string= package-menu-sort-key "Version") + ;; FIXME this doesn't work. + #'(lambda (e) (cdr (car e)))) + ((string= package-menu-sort-key "Status") + #'(lambda (e) (car (cdr e)))) + ((string= package-menu-sort-key "Description") + #'(lambda (e) (car (cdr (cdr e))))) + (t ; "Package" is default. + #'(lambda (e) (symbol-name (car (car e)))))))) + (setq info-list + (sort info-list + (lambda (left right) + (let ((vleft (funcall selector left)) + (vright (funcall selector right))) + (string< vleft vright)))))) + (mapc (lambda (elt) + (package-print-package (car (car elt)) + (cdr (car elt)) + (car (cdr elt)) + (car (cdr (cdr elt))))) + info-list)) + (goto-char (point-min)) + (current-buffer))) + +(defun package-menu-sort-by-column (&optional e) + "Sort the package menu by the last column clicked on." + (interactive (list last-input-event)) + (if e (mouse-select-window e)) + (let* ((pos (event-start e)) + (obj (posn-object pos)) + (col (if obj + (get-text-property (cdr obj) 'column-name (car obj)) + (get-text-property (posn-point pos) 'column-name)))) + (setq package-menu-sort-key col)) + (package-list-packages-internal)) + +(defun package--list-packages () + "Display a list of packages. +Helper function that does all the work for the user-facing functions." + (with-current-buffer (package-list-packages-internal) + (package-menu-mode) + ;; Set up the header line. + (setq header-line-format + (mapconcat + (lambda (pair) + (let ((column (car pair)) + (name (cdr pair))) + (concat + ;; Insert a space that aligns the button properly. + (propertize " " 'display (list 'space :align-to column) + 'face 'fixed-pitch) + ;; Set up the column button. + (if (string= name "Version") + name + (propertize name + 'column-name name + 'help-echo "mouse-1: sort by column" + 'mouse-face 'highlight + 'keymap package-menu-sort-button-map))))) + ;; We take a trick from buff-menu and have a dummy leading + ;; space to align the header line with the beginning of the + ;; text. This doesn't really work properly on Emacs 21, + ;; but it is close enough. + '((0 . "") + (2 . "Package") + (20 . "Version") + (30 . "Status") + (41 . "Description")) + "")) + + ;; It's okay to use pop-to-buffer here. The package menu buffer + ;; has keybindings, and the user just typed 'M-x + ;; package-list-packages', suggesting that they might want to use + ;; them. + (pop-to-buffer (current-buffer)))) + +(defun package-list-packages () + "Display a list of packages. +Fetches the updated list of packages before displaying. +The list is displayed in a buffer named `*Packages*'." + (interactive) + (package-refresh-contents) + (package--list-packages)) + +(defun package-list-packages-no-fetch () + "Display a list of packages. +Does not fetch the updated list of packages before displaying. +The list is displayed in a buffer named `*Packages*'." + (interactive) + (package--list-packages)) + +;; Make it appear on the menu. +(define-key-after menu-bar-options-menu [package] + '(menu-item "Manage Packages" package-list-packages + :help "Install or uninstall additional Emacs packages")) + + + +(eval-when-compile + (require 'reporter)) + +(defun package-report-bug () + "Submit a bug report for package.el via email." + (interactive) + (require 'reporter) + (reporter-submit-bug-report + package-el-maintainer + (concat "package.el " package-el-version) + '(package-archive-base + package-archive-version + package-archive-contents + package-user-dir + package-directory-list + package-alist + package-activated-list + package-obsolete-alist))) + +(provide 'package) + +;;; package.el ends here diff --git a/.emacs.d/elpa/package.el~ b/.emacs.d/elpa/package.el~ new file mode 100644 index 0000000..1cecbe3 --- /dev/null +++ b/.emacs.d/elpa/package.el~ @@ -0,0 +1,1507 @@ +;;; package.el --- Simple package system for Emacs + +;; Copyright (C) 2007, 2008, 2009 Tom Tromey <tromey@redhat.com> + +;; Author: Tom Tromey <tromey@redhat.com> +;; Created: 10 Mar 2007 +;; Version: 0.9 +;; Keywords: tools + +;; This file is not (yet) part of GNU Emacs. +;; However, it is distributed under the same license. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Change Log: + +;; 2 Apr 2007 - now using ChangeLog file +;; 15 Mar 2007 - updated documentation +;; 14 Mar 2007 - Changed how obsolete packages are handled +;; 13 Mar 2007 - Wrote package-install-from-buffer +;; 12 Mar 2007 - Wrote package-menu mode + +;;; Commentary: + +;; To use this, put package.el somewhere on your load-path. Then add +;; this to your .emacs: +;; +;; (load "package") +;; (package-initialize) +;; +;; This will automatically make available the packages you have +;; installed using package.el. If your .emacs will refer to these +;; packages, you may want to initialize the package manager near the +;; top. +;; +;; Note that if you want to be able to automatically download and +;; install packages from ELPA (the Emacs Lisp Package Archive), then +;; you will need the 'url' package. This comes with Emacs 22; Emacs +;; 21 users will have to find it elsewhere. +;; +;; If you installed package.el via the auto-installer: +;; +;; http://tromey.com/elpa/ +;; +;; then you do not need to edit your .emacs, as the installer will +;; have done this for you. The installer will also install the url +;; package if you need it. + +;; Other external functions you may want to use: +;; +;; M-x package-list-packages +;; Enters a mode similar to buffer-menu which lets you manage +;; packages. You can choose packages for install (mark with "i", +;; then "x" to execute) or deletion (not implemented yet), and you +;; can see what packages are available. This will automatically +;; fetch the latest list of packages from ELPA. +;; +;; M-x package-list-packages-no-fetch +;; Like package-list-packages, but does not automatically fetch the +;; new list of packages. +;; +;; M-x package-install-from-buffer +;; Install a package consisting of a single .el file that appears +;; in the current buffer. This only works for packages which +;; define a Version header properly; package.el also supports the +;; extension headers Package-Version (in case Version is an RCS id +;; or similar), and Package-Requires (if the package requires other +;; packages). +;; +;; M-x package-install-file +;; Install a package from the indicated file. The package can be +;; either a tar file or a .el file. A tar file must contain an +;; appropriately-named "-pkg.el" file; a .el file must be properly +;; formatted as with package-install-from-buffer. + +;; The idea behind package.el is to be able to download packages and +;; install them. Packages are versioned and have versioned +;; dependencies. Furthermore, this supports built-in packages which +;; may or may not be newer than user-specified packages. This makes +;; it possible to upgrade Emacs and automatically disable packages +;; which have moved from external to core. (Note though that we don't +;; currently register any of these, so this feature does not actually +;; work.) + +;; This code supports a single package repository, ELPA. All packages +;; must be registered there. + +;; A package is described by its name and version. The distribution +;; format is either a tar file or a single .el file. + +;; A tar file should be named "NAME-VERSION.tar". The tar file must +;; unpack into a directory named after the package and version: +;; "NAME-VERSION". It must contain a file named "PACKAGE-pkg.el" +;; which consists of a call to define-package. It may also contain a +;; "dir" file and the info files it references. + +;; A .el file will be named "NAME-VERSION.el" in ELPA, but will be +;; installed as simply "NAME.el" in a directory named "NAME-VERSION". + +;; The downloader will download all dependent packages. It will also +;; byte-compile the package's lisp at install time. + +;; At activation time we will set up the load-path and the info path, +;; and we will load the package's autoloads. If a package's +;; dependencies are not available, we will not activate that package. + +;; Conceptually a package has multiple state transitions: +;; +;; * Download. Fetching the package from ELPA. +;; * Install. Untar the package, or write the .el file, into +;; ~/.emacs.d/elpa/ directory. +;; * Byte compile. Currently this phase is done during install, +;; but we may change this. +;; * Activate. Evaluate the autoloads for the package to make it +;; available to the user. +;; * Load. Actually load the package and run some code from it. + +;;; Thanks: +;;; (sorted by sort-lines): + +;; Jim Blandy <jimb@red-bean.com> +;; Karl Fogel <kfogel@red-bean.com> +;; Kevin Ryde <user42@zip.com.au> +;; Lawrence Mitchell +;; Michael Olson <mwolson@member.fsf.org> +;; Sebastian Tennant <sebyte@smolny.plus.com> +;; Stefan Monnier <monnier@iro.umontreal.ca> +;; Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Phil Hagelberg <phil@hagelb.org> + +;;; ToDo: + +;; - putting info dirs at the start of the info path means +;; users see a weird ordering of categories. OTOH we want to +;; override later entries. maybe emacs needs to enforce +;; the standard layout? +;; - put bytecode in a separate directory tree +;; - perhaps give users a way to recompile their bytecode +;; or do it automatically when emacs changes +;; - give users a way to know whether a package is installed ok +;; - give users a way to view a package's documentation when it +;; only appears in the .el +;; - use/extend checkdoc so people can tell if their package will work +;; - "installed" instead of a blank in the status column +;; - tramp needs its files to be compiled in a certain order. +;; how to handle this? fix tramp? +;; - on emacs 21 we don't kill the -autoloads.el buffer. what about 22? +;; - maybe we need separate .elc directories for various emacs versions +;; and also emacs-vs-xemacs. That way conditional compilation can +;; work. But would this break anything? +;; - should store the package's keywords in archive-contents, then +;; let the users filter the package-menu by keyword. See +;; finder-by-keyword. (We could also let people view the +;; Commentary, but it isn't clear how useful this is.) +;; - William Xu suggests being able to open a package file without +;; installing it +;; - Interface with desktop.el so that restarting after an install +;; works properly +;; - Implement M-x package-upgrade, to upgrade any/all existing packages +;; - Use hierarchical layout. PKG/etc PKG/lisp PKG/info +;; ... except maybe lisp? +;; - It may be nice to have a macro that expands to the package's +;; private data dir, aka ".../etc". Or, maybe data-directory +;; needs to be a list (though this would be less nice) +;; a few packages want this, eg sokoban +;; - package menu needs: +;; ability to know which packages are built-in & thus not deletable +;; it can sometimes print odd results, like 0.3 available but 0.4 active +;; why is that? +;; - Allow multiple versions on the server...? +;; [ why bother? ] +;; - Don't install a package which will invalidate dependencies overall +;; - Allow something like (or (>= emacs 21.0) (>= xemacs 21.5)) +;; [ currently thinking, why bother.. KISS ] +;; - Allow optional package dependencies +;; then if we require 'bbdb', bbdb-specific lisp in lisp/bbdb +;; and just don't compile to add to load path ...? +;; - Have a list of archive URLs? [ maybe there's no point ] +;; - David Kastrup pointed out on the xemacs list that for GPL it +;; is friendlier to ship the source tree. We could "support" that +;; by just having a "src" subdir in the package. This isn't ideal +;; but it probably is not worth trying to support random source +;; tree layouts, build schemes, etc. +;; - Our treatment of the info path is somewhat bogus +;; - perhaps have an "unstable" tree in ELPA as well as a stable one + +;;; Code: + +(defconst package-archive-base "http://tromey.com/elpa/" + "Base URL for the package archive. +Ordinarily you should not need to edit this. +The default points to ELPA, the Emacs Lisp Package Archive. +Note that some code in package.el assumes that this is an http: URL.") + +(defconst package-archive-version 1 + "Version number of the package archive understood by this file. +Lower version numbers than this will probably be understood as well.") + +;; Note that this only works if you have the password, which you +;; probably don't :-). Also if you are using Emacs 21 then you will +;; need to hack ange-ftp-name-format to make this work. +(defvar package-archive-upload-base "/elpa@tromey.com@tromey.com:/" + "Base location for uploading to package archive.") + +(defconst package-el-maintainer "Tom Tromey <elpa@tromey.com>" + "The package.el maintainer.") + +(defconst package-el-version "0.9" + "Version of package.el.") + +;; We don't prime the cache since it tends to get out of date. +(defvar package-archive-contents + nil + "A representation of the contents of the ELPA archive. +This is an alist mapping package names (symbols) to package +descriptor vectors. These are like the vectors for `package-alist' +but have an extra entry which is 'tar for tar packages and +'single for single-file packages.") + +(defvar package-user-dir + (expand-file-name (convert-standard-filename "~/.emacs.d/elpa")) + "Name of the directory where the user's packages are stored.") + +(defvar package-directory-list + (list (file-name-as-directory package-user-dir) + "/usr/share/emacs/site-lisp/elpa/") + "List of directories to search for packages.") + +(defun package-version-split (string) + "Split a package string into a version list." + (mapcar 'string-to-int (split-string string "[.]"))) + +(defconst package--builtins-base + ;; We use package-version split here to make sure to pick up the + ;; minor version. + `((emacs . [,(package-version-split emacs-version) nil + "GNU Emacs"]) + (package . [,(package-version-split package-el-version) + nil "Simple package system for GNU Emacs"])) + "Packages which are always built-in.") + +(defvar package--builtins + (delq nil + (append + package--builtins-base + (if (>= emacs-major-version 22) + ;; FIXME: emacs 22 includes tramp, rcirc, maybe + ;; other things... + '((erc . [(5 2) nil "An Emacs Internet Relay Chat client"]) + ;; The external URL is version 1.15, so make sure the + ;; built-in one looks newer. + (url . [(1 16) nil "URL handling libary"]))) + (if (>= emacs-major-version 23) + '(;; Strangely, nxml-version is missing in Emacs 23. + ;; We pick the merge date as the version. + (nxml . [(20071123) nil "Major mode for editing XML documents."]) + (bubbles . [(0 5) nil "Puzzle game for Emacs."]))))) + "Alist of all built-in packages. +Maps the package name to a vector [VERSION REQS DOCSTRING].") + +(defvar package-alist package--builtins + "Alist of all packages available for activation. +Maps the package name to a vector [VERSION REQS DOCSTRING].") + +(defvar package-activated-list + (mapcar #'car package-alist) + "List of the names of all activated packages.") + +(defvar package-obsolete-alist nil + "Representation of obsolete packages. +Like `package-alist', but maps package name to a second alist. +The inner alist is keyed by version.") + +(defun package-version-join (l) + "Turn a list of version numbers into a version string." + (mapconcat 'int-to-string l ".")) + +(defun package--version-first-nonzero (l) + (while (and l (= (car l) 0)) + (setq l (cdr l))) + (if l (car l) 0)) + +(defun package-version-compare (v1 v2 fun) + "Compare two version lists according to FUN. +FUN can be <, <=, =, >, >=, or /=." + (while (and v1 v2 (= (car v1) (car v2))) + (setq v1 (cdr v1) + v2 (cdr v2))) + (if v1 + (if v2 + ;; Both not null; we know the cars are not =. + (funcall fun (car v1) (car v2)) + ;; V1 not null, V2 null. + (funcall fun (package--version-first-nonzero v1) 0)) + (if v2 + ;; V1 null, V2 not null. + (funcall fun 0 (package--version-first-nonzero v2)) + ;; Both null. + (funcall fun 0 0)))) + +(defun package--test-version-compare () + "Test suite for `package-version-compare'." + (unless (and (package-version-compare '(0) '(0) '=) + (not (package-version-compare '(1) '(0) '=)) + (package-version-compare '(1 0 1) '(1) '>=) + (package-version-compare '(1 0 1) '(1) '>) + (not (package-version-compare '(0 9 1) '(1 0 2) '>=))) + (error "Failed")) + t) + +(defun package-strip-version (dirname) + "Strip the version from a combined package name and version. +E.g., if given \"quux-23.0\", will return \"quux\"" + (if (string-match "^\\(.*\\)-[0-9]+\\([.][0-9]+\\)*$" dirname) + (match-string 1 dirname))) + +(defun package-load-descriptor (dir package) + "Load the description file for a package. +Return nil if the package could not be found." + (let ((pkg-dir (concat (file-name-as-directory dir) package "/"))) + (if (file-directory-p pkg-dir) + (load (concat pkg-dir (package-strip-version package) "-pkg") nil t)))) + +(defun package-load-all-descriptors () + "Load descriptors of all packages. +Uses `package-directory-list' to find packages." + (mapc (lambda (dir) + (if (file-directory-p dir) + (mapc (lambda (name) + (package-load-descriptor dir name)) + (directory-files dir nil "^[^.]")))) + package-directory-list)) + +(defsubst package-desc-vers (desc) + "Extract version from a package description vector." + (aref desc 0)) + +(defsubst package-desc-reqs (desc) + "Extract requirements from a package description vector." + (aref desc 1)) + +(defsubst package-desc-doc (desc) + "Extract doc string from a package description vector." + (aref desc 2)) + +(defsubst package-desc-kind (desc) + "Extract the kind of download from an archive package description vector." + (aref desc 3)) + +(defun package-do-activate (package pkg-vec) + (let* ((pkg-name (symbol-name package)) + (pkg-ver-str (package-version-join (package-desc-vers pkg-vec))) + (dir-list package-directory-list) + (pkg-dir)) + (while dir-list + (let ((subdir (concat (car dir-list) pkg-name "-" pkg-ver-str "/"))) + (if (file-directory-p subdir) + (progn + (setq pkg-dir subdir) + (setq dir-list nil)) + (setq dir-list (cdr dir-list))))) + (unless pkg-dir + (error "Internal error: could not find directory for %s-%s" + pkg-name pkg-ver-str)) + (if (file-exists-p (concat pkg-dir "dir")) + (progn + ;; FIXME: not the friendliest, but simple. + (require 'info) + (info-initialize) + (setq Info-directory-list (cons pkg-dir Info-directory-list)))) + (setq load-path (cons pkg-dir load-path)) + ;; Load the autoloads and activate the package. + (load (concat pkg-dir (symbol-name package) "-autoloads") + nil t) + (setq package-activated-list (cons package package-activated-list)) + ;; Don't return nil. + t)) + +(defun package--built-in (package version) + "Return true if the package is built-in to Emacs." + (let ((elt (assq package package--builtins))) + (and elt + (package-version-compare (package-desc-vers (cdr elt)) version '=)))) + +;; FIXME: return a reason instead? +(defun package-activate (package version) + "Try to activate a package. +Return nil if the package could not be activated. +Recursively activates all dependencies of the named package." + ;; Assume the user knows what he is doing -- go ahead and activate a + ;; newer version of a package if an older one has already been + ;; activated. This is not ideal; we'd at least need to check to see + ;; if the package has actually been loaded, and not merely + ;; activated. However, don't try to activate 'emacs', as that makes + ;; no sense. + (unless (eq package 'emacs) + (let* ((pkg-desc (assq package package-alist)) + (this-version (package-desc-vers (cdr pkg-desc))) + (req-list (package-desc-reqs (cdr pkg-desc))) + ;; If the package was never activated, we want to do it + ;; now. + (keep-going (or (not (memq package package-activated-list)) + (package-version-compare this-version version '>)))) + (while (and req-list keep-going) + (or (package-activate (car (car req-list)) + (car (cdr (car req-list)))) + (setq keep-going nil)) + (setq req-list (cdr req-list))) + (if keep-going + (package-do-activate package (cdr pkg-desc)) + ;; We get here if a dependency failed to activate -- but we + ;; can also get here if the requested package was already + ;; activated. Return non-nil in the latter case. + (and (memq package package-activated-list) + (package-version-compare this-version version '>=)))))) + +(defun package-mark-obsolete (package pkg-vec) + "Put package on the obsolete list, if not already there." + (let ((elt (assq package package-obsolete-alist))) + (if elt + ;; If this obsolete version does not exist in the list, update + ;; it the list. + (unless (assoc (package-desc-vers pkg-vec) (cdr elt)) + (setcdr elt (cons (cons (package-desc-vers pkg-vec) pkg-vec) + (cdr elt)))) + ;; Make a new association. + (setq package-obsolete-alist + (cons (cons package (list (cons (package-desc-vers pkg-vec) + pkg-vec))) + package-obsolete-alist))))) + +;; (define-package "emacs" "21.4.1" "GNU Emacs core package.") +;; (define-package "erc" "5.1" "ERC - irc client" '((emacs "21.0"))) +(defun define-package (name-str version-string + &optional docstring requirements) + "Define a new package. +NAME is the name of the package, a string. +VERSION-STRING is the version of the package, a dotted sequence +of integers. +DOCSTRING is the optional description. +REQUIREMENTS is a list of requirements on other packages. +Each requirement is of the form (OTHER-PACKAGE \"VERSION\")." + (let* ((name (intern name-str)) + (pkg-desc (assq name package-alist)) + (new-version (package-version-split version-string)) + (new-pkg-desc + (cons name + (vector new-version + (mapcar + (lambda (elt) + (list (car elt) + (package-version-split (car (cdr elt))))) + requirements) + docstring)))) + ;; Only redefine a package if the redefinition is newer. + (if (or (not pkg-desc) + (package-version-compare new-version + (package-desc-vers (cdr pkg-desc)) + '>)) + (progn + (when pkg-desc + ;; Remove old package and declare it obsolete. + (setq package-alist (delq pkg-desc package-alist)) + (package-mark-obsolete (car pkg-desc) (cdr pkg-desc))) + ;; Add package to the alist. + (setq package-alist (cons new-pkg-desc package-alist))) + ;; You can have two packages with the same version, for instance + ;; one in the system package directory and one in your private + ;; directory. We just let the first one win. + (unless (package-version-compare new-version + (package-desc-vers (cdr pkg-desc)) + '=) + ;; The package is born obsolete. + (package-mark-obsolete (car new-pkg-desc) (cdr new-pkg-desc)))))) + +;; From Emacs 22. +(defun package-autoload-ensure-default-file (file) + "Make sure that the autoload file FILE exists and if not create it." + (unless (file-exists-p file) + (write-region + (concat ";;; " (file-name-nondirectory file) + " --- automatically extracted autoloads\n" + ";;\n" + ";;; Code:\n\n" + " \n;; Local Variables:\n" + ";; version-control: never\n" + ";; no-byte-compile: t\n" + ";; no-update-autoloads: t\n" + ";; End:\n" + ";;; " (file-name-nondirectory file) + " ends here\n") + nil file)) + file) + +(defun package-generate-autoloads (name pkg-dir) + (let* ((auto-name (concat name "-autoloads.el")) + (ignore-name (concat name "-pkg.el")) + (generated-autoload-file (concat pkg-dir auto-name)) + (version-control 'never)) + ;; In Emacs 22 'update-autoloads-from-directories' does not seem + ;; to be autoloaded... + (require 'autoload) + (unless (fboundp 'autoload-ensure-default-file) + (package-autoload-ensure-default-file generated-autoload-file)) + (update-autoloads-from-directories pkg-dir))) + +(defun package-untar-buffer () + "Untar the current buffer. +This uses `tar-untar-buffer' if it is available. +Otherwise it uses an external `tar' program. +`default-directory' should be set by the caller." + (require 'tar-mode) + (if (fboundp 'tar-untar-buffer) + (progn + ;; tar-mode messes with narrowing, so we just let it have the + ;; whole buffer to play with. + (delete-region (point-min) (point)) + (tar-mode) + (tar-untar-buffer)) + ;; FIXME: check the result. + (call-process-region (point) (point-max) "tar" nil '(nil nil) nil + "xf" "-"))) + +(defun package-unpack (name version) + (let ((pkg-dir (concat (file-name-as-directory package-user-dir) + (symbol-name name) "-" version "/"))) + ;; Be careful!! + (make-directory package-user-dir t) + (if (file-directory-p pkg-dir) + (mapc (lambda (file) nil) ; 'delete-file -- FIXME: when we're + ; more confident + (directory-files pkg-dir t "^[^.]"))) + (let* ((default-directory (file-name-as-directory package-user-dir))) + (package-untar-buffer) + (package-generate-autoloads (symbol-name name) pkg-dir) + (let ((load-path (cons pkg-dir load-path))) + (byte-recompile-directory pkg-dir 0 t))))) + +(defun package-unpack-single (file-name version desc requires) + "Install the contents of the current buffer as a package." + (let* ((dir (file-name-as-directory package-user-dir))) + ;; Special case "package". + (if (string= file-name "package") + (write-region (point-min) (point-max) (concat dir file-name ".el") + nil nil nil nil) + (let ((pkg-dir (file-name-as-directory + (concat dir file-name "-" version)))) + (make-directory pkg-dir t) + (write-region (point-min) (point-max) + (concat pkg-dir file-name ".el") + nil nil nil 'excl) + (let ((print-level nil) + (print-length nil)) + (write-region + (concat + (prin1-to-string + (list 'define-package + file-name + version + desc + (list 'quote + ;; Turn version lists into string form. + (mapcar + (lambda (elt) + (list (car elt) + (package-version-join (car (cdr elt))))) + requires)))) + "\n") + nil + (concat pkg-dir file-name "-pkg.el") + nil nil nil 'excl)) + (package-generate-autoloads file-name pkg-dir) + (let ((load-path (cons pkg-dir load-path))) + (byte-recompile-directory pkg-dir 0 t)))))) + +(defun package-handle-response () + "Handle the response from the server. +Parse the HTTP response and throw if an error occurred. +The url package seems to require extra processing for this. +This should be called in a `save-excursion', in the download buffer. +It will move point to somewhere in the headers." + ;; We assume HTTP here. + (let ((response (url-http-parse-response))) + (when (or (< response 200) (>= response 300)) + (display-buffer (current-buffer)) + (error "Error during download request:%s" + (buffer-substring-no-properties (point) (progn + (end-of-line) + (point))))))) + +(defun package-download-single (name version desc requires) + "Download and install a single-file package." + (let ((buffer (url-retrieve-synchronously + (concat package-archive-base + (symbol-name name) "-" version ".el")))) + (save-excursion + (set-buffer buffer) + (package-handle-response) + (re-search-forward "^$" nil 'move) + (forward-char) + (delete-region (point-min) (point)) + (package-unpack-single (symbol-name name) version desc requires) + (kill-buffer buffer)))) + +(defun package-download-tar (name version) + "Download and install a tar package." + (let ((tar-buffer (url-retrieve-synchronously + (concat package-archive-base + (symbol-name name) "-" version ".tar")))) + (save-excursion + (set-buffer tar-buffer) + (package-handle-response) + (re-search-forward "^$" nil 'move) + (forward-char) + (package-unpack name version) + (kill-buffer tar-buffer)))) + +(defun package-installed-p (package version) + (let ((pkg-desc (assq package package-alist))) + (and pkg-desc + (package-version-compare version + (package-desc-vers (cdr pkg-desc)) + '>=)))) + +(defun package-compute-transaction (result requirements) + (while requirements + (let* ((elt (car requirements)) + (next-pkg (car elt)) + (next-version (car (cdr elt)))) + (unless (package-installed-p next-pkg next-version) + (let ((pkg-desc (assq next-pkg package-archive-contents))) + (unless pkg-desc + (error "Package '%s' not available for installation" + (symbol-name next-pkg))) + (unless (package-version-compare (package-desc-vers (cdr pkg-desc)) + next-version + '>=) + (error + "Need package '%s' with version %s, but only %s is available" + (symbol-name next-pkg) (package-version-join next-version) + (package-version-join (package-desc-vers (cdr pkg-desc))))) + ;; Only add to the transaction if we don't already have it. + (unless (memq next-pkg result) + (setq result (cons next-pkg result))) + (setq result + (package-compute-transaction result + (package-desc-reqs + (cdr pkg-desc))))))) + (setq requirements (cdr requirements))) + result) + +(defun package-read-from-string (str) + "Read a Lisp expression from STR. +Signal an error if the entire string was not used." + (let* ((read-data (read-from-string str)) + (more-left + (condition-case nil + ;; The call to `ignore' suppresses a compiler warning. + (progn (ignore (read-from-string + (substring str (cdr read-data)))) + t) + (end-of-file nil)))) + (if more-left + (error "Can't read whole string") + (car read-data)))) + +(defun package--read-archive-file (file) + "Re-read archive file FILE, if it exists. +Will return the data from the file, or nil if the file does not exist. +Will throw an error if the archive version is too new." + (let ((filename (concat (file-name-as-directory package-user-dir) + file))) + (if (file-exists-p filename) + (with-temp-buffer + (insert-file-contents-literally filename) + (let ((contents (package-read-from-string + (buffer-substring-no-properties (point-min) + (point-max))))) + (if (> (car contents) package-archive-version) + (error "Package archive version %d is greater than %d - upgrade package.el" + (car contents) package-archive-version)) + (cdr contents)))))) + +(defun package-read-archive-contents () + "Re-read `archive-contents' and `builtin-packages', if they exist. +Will set `package-archive-contents' and `package--builtins' if successful. +Will throw an error if the archive version is too new." + (let ((archive-contents (package--read-archive-file "archive-contents")) + (builtins (package--read-archive-file "builtin-packages"))) + (if archive-contents + ;; Version 1 of 'archive-contents' is identical to our + ;; internal representation. + (setq package-archive-contents archive-contents)) + (if builtins + ;; Version 1 of 'builtin-packages' is a list where the car is + ;; a split emacs version and the cdr is an alist suitable for + ;; package--builtins. + (let ((our-version (package-version-split emacs-version)) + (result package--builtins-base)) + (setq package--builtins + (dolist (elt builtins result) + (if (package-version-compare our-version (car elt) '>=) + (setq result (append (cdr elt) result))))))))) + +(defun package-download-transaction (transaction) + "Download and install all the packages in the given transaction." + (mapc (lambda (elt) + (let* ((desc (cdr (assq elt package-archive-contents))) + (v-string (package-version-join (package-desc-vers desc))) + (kind (package-desc-kind desc))) + (cond + ((eq kind 'tar) + (package-download-tar elt v-string)) + ((eq kind 'single) + (package-download-single elt v-string + (package-desc-doc desc) + (package-desc-reqs desc))) + (t + (error "Unknown package kind: " (symbol-name kind)))))) + transaction)) + +(defun package-install (name) + "Install the package named NAME. +Interactively, prompts for the package name. +The package is found on the archive site, see `package-archive-base'." + (interactive + (list (progn + ;; Make sure we're using the most recent download of the + ;; archive. Maybe we should be updating the archive first? + (package-read-archive-contents) + (intern (completing-read "Install package: " + (mapcar (lambda (elt) + (cons (symbol-name (car elt)) + nil)) + package-archive-contents) + nil t))))) + (let ((pkg-desc (assq name package-archive-contents))) + (unless pkg-desc + (error "Package '%s' not available for installation" + (symbol-name name))) + (let ((transaction + (package-compute-transaction (list name) + (package-desc-reqs (cdr pkg-desc))))) + (package-download-transaction transaction))) + ;; Try to activate it. + (package-initialize)) + +(defun package-strip-rcs-id (v-str) + "Strip RCS version ID from the version string. +If the result looks like a dotted numeric version, return it. +Otherwise return nil." + (if v-str + (if (string-match "^[ \t]*[$]Revision:[ \t]\([0-9.]+\)[ \t]*[$]$" v-str) + (match-string 1 v-str) + (if (string-match "^[0-9.]*$" v-str) + v-str)))) + +(defun package-buffer-info () + "Return a vector of information about the package in the current buffer. +The vector looks like [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY] +FILENAME is the file name, a string. It does not have the \".el\" extension. +REQUIRES is a requires list, or nil. +DESCRIPTION is the package description (a string). +VERSION is the version, a string. +COMMENTARY is the commentary section, a string, or nil if none. +Throws an exception if the buffer does not contain a conforming package. +If there is a package, narrows the buffer to the file's boundaries. +May narrow buffer or move point even on failure." + (goto-char (point-min)) + (if (re-search-forward "^;;; \\([^ ]*\\)\\.el --- \\(.*\\)$" nil t) + (let ((file-name (match-string 1)) + (desc (match-string 2)) + (start (progn (beginning-of-line) (point)))) + (if (search-forward (concat ";;; " file-name ".el ends here")) + (progn + ;; Try to include a trailing newline. + (forward-line) + (narrow-to-region start (point)) + (require 'lisp-mnt) + ;; Use some headers we've invented to drive the process. + (let* ((requires-str (lm-header "package-requires")) + (requires (if requires-str + (package-read-from-string requires-str))) + ;; Prefer Package-Version, because if it is + ;; defined the package author probably wants us + ;; to use it. Otherwise try Version. + (pkg-version + (or (package-strip-rcs-id (lm-header "package-version")) + (package-strip-rcs-id (lm-header "version")))) + (commentary (lm-commentary))) + (unless pkg-version + (error + "Package does not define a usable \"Version\" or \"Package-Version\" header")) + ;; Turn string version numbers into list form. + (setq requires + (mapcar + (lambda (elt) + (list (car elt) + (package-version-split (car (cdr elt))))) + requires)) + (set-text-properties 0 (length file-name) nil file-name) + (set-text-properties 0 (length pkg-version) nil pkg-version) + (set-text-properties 0 (length desc) nil desc) + (vector file-name requires desc pkg-version commentary))) + (error "Package missing a terminating comment"))) + (error "No starting comment for package"))) + +(defun package-tar-file-info (file) + "Find package information for a tar file. +FILE is the name of the tar file to examine. +The return result is a vector like `package-buffer-info'." + (unless (string-match "^\\(.+\\)-\\([0-9.]+\\)\\.tar$" file) + (error "`%s' doesn't have a package-ish name" file)) + (let* ((pkg-name (file-name-nondirectory (match-string-no-properties 1 file))) + (pkg-version (match-string-no-properties 2 file)) + ;; Extract the package descriptor. + (pkg-def-contents (shell-command-to-string + ;; Requires GNU tar. + (concat "tar -xOf " file " " + pkg-name "-" pkg-version "/" + pkg-name "-pkg.el"))) + (pkg-def-parsed (package-read-from-string pkg-def-contents))) + (unless (eq (car pkg-def-parsed) 'define-package) + (error "%s-pkg.el doesn't contain `define-package' sexp" pkg-name)) + (let ((name-str (nth 1 pkg-def-parsed)) + (version-string (nth 2 pkg-def-parsed)) + (docstring (nth 3 pkg-def-parsed)) + (requires (nth 4 pkg-def-parsed)) + + (readme (shell-command-to-string + ;; Requires GNU tar. + (concat "tar -xOf " file " " + pkg-name "-" pkg-version "/README")))) + (unless (equal pkg-version version-string) + (error "Inconsistent versions!")) + (unless (equal pkg-name name-str) + (error "Inconsistent names!")) + ;; Kind of a hack. + (if (string-match ": Not found in archive" readme) + (setq readme nil)) + ;; Turn string version numbers into list form. + (if (eq (car requires) 'quote) + (setq requires (car (cdr requires)))) + (setq requires + (mapcar + (lambda (elt) + (list (car elt) + (package-version-split (car (cdr elt))))) + requires)) + (vector pkg-name requires docstring version-string readme)))) + +(defun package-install-buffer-internal (pkg-info type) + (save-excursion + (save-restriction + (let* ((file-name (aref pkg-info 0)) + (requires (aref pkg-info 1)) + (desc (if (string= (aref pkg-info 2) "") + "No description available." + (aref pkg-info 2))) + (pkg-version (aref pkg-info 3))) + ;; Download and install the dependencies. + (let ((transaction (package-compute-transaction nil requires))) + (package-download-transaction transaction)) + ;; Install the package itself. + (cond + ((eq type 'single) + (package-unpack-single file-name pkg-version desc requires)) + ((eq type 'tar) + (package-unpack (intern file-name) pkg-version)) + (t + (error "Unknown type: %s" (symbol-name type)))) + ;; Try to activate it. + (package-initialize))))) + +(defun package-install-from-buffer () + "Install a package from the current buffer. +The package is assumed to be a single .el file which +follows the elisp comment guidelines; see +info node `(elisp)Library Headers'." + (interactive) + (package-install-buffer-internal (package-buffer-info) 'single)) + +(defun package-install-file (file) + "Install a package from a file. +The file can either be a tar file or an Emacs Lisp file." + (interactive "fPackage file name: ") + (with-temp-buffer + (insert-file-contents-literally file) + (cond + ((string-match "\\.el$" file) (package-install-from-buffer)) + ((string-match "\\.tar$" file) + (package-install-buffer-internal (package-tar-file-info file) 'tar)) + (t (error "Unrecognized extension `%s'" (file-name-extension file)))))) + +(defun package-delete (name version) + (require 'dired) ; for dired-delete-file + (dired-delete-file (concat (file-name-as-directory package-user-dir) + name "-" version) + ;; FIXME: query user? + 'always)) + +(defun package--encode (string) + "Encode a string by replacing some characters with XML entities." + ;; We need a special case for translating "&" to "&". + (let ((index)) + (while (setq index (string-match "[&]" string index)) + (setq string (replace-match "&" t nil string)) + (setq index (1+ index)))) + (while (string-match "[<]" string) + (setq string (replace-match "<" t nil string))) + (while (string-match "[>]" string) + (setq string (replace-match ">" t nil string))) + (while (string-match "[']" string) + (setq string (replace-match "'" t nil string))) + (while (string-match "[\"]" string) + (setq string (replace-match """ t nil string))) + string) + +(defun package--make-rss-entry (title text) + (let ((date-string (format-time-string "%a, %d %B %Y %T %z"))) + (concat "<item>\n" + "<title>" (package--encode title) "</title>\n" + ;; FIXME: should have a link in the web page. + "<link>" package-archive-base "news.html</link>\n" + "<description>" (package--encode text) "</description>\n" + "<pubDate>" date-string "</pubDate>\n" + "</item>\n"))) + +(defun package--make-html-entry (title text) + (concat "<li> " (format-time-string "%B %e") " - " + title " - " (package--encode text) + " </li>\n")) + +(defun package--update-file (file location text) + (save-excursion + (let ((old-buffer (find-buffer-visiting file))) + (with-current-buffer (let ((find-file-visit-truename t)) + (or old-buffer (find-file-noselect file))) + (goto-char (point-min)) + (search-forward location) + (forward-line) + (insert text) + (let ((file-precious-flag t)) + (save-buffer)) + (unless old-buffer + (kill-buffer (current-buffer))))))) + +(defun package-maint-add-news-item (title description) + "Add a news item to the ELPA web pages. +TITLE is the title of the news item. +DESCRIPTION is the text of the news item. +You need administrative access to ELPA to use this." + (interactive "sTitle: \nsText: ") + (package--update-file (concat package-archive-upload-base "elpa.rss") + "<description>" + (package--make-rss-entry title description)) + (package--update-file (concat package-archive-upload-base "news.html") + "New entries go here" + (package--make-html-entry title description))) + +(defun package--update-news (package version description) + "Update the ELPA web pages when a package is uploaded." + (package-maint-add-news-item (concat package " version " version) + description)) + +(defun package-upload-buffer-internal (pkg-info extension) + "Upload a package whose contents are in the current buffer. +PKG-INFO is the package info, see `package-buffer-info'. +EXTENSION is the file extension, a string. It can be either +\"el\" or \"tar\"." + (save-excursion + (save-restriction + (let* ((file-type (cond + ((equal extension "el") 'single) + ((equal extension "tar") 'tar) + (t (error "Unknown extension `%s'" extension)))) + (file-name (aref pkg-info 0)) + (pkg-name (intern file-name)) + (requires (aref pkg-info 1)) + (desc (if (string= (aref pkg-info 2) "") + (read-string "Description of package: ") + (aref pkg-info 2))) + (pkg-version (aref pkg-info 3)) + (commentary (aref pkg-info 4)) + (split-version (package-version-split pkg-version)) + (pkg-buffer (current-buffer)) + + ;; Download latest archive-contents. + (buffer (url-retrieve-synchronously + (concat package-archive-base "archive-contents")))) + + ;; Parse archive-contents. + (set-buffer buffer) + (package-handle-response) + (re-search-forward "^$" nil 'move) + (forward-char) + (delete-region (point-min) (point)) + (let ((contents (package-read-from-string + (buffer-substring-no-properties (point-min) + (point-max)))) + (new-desc (vector split-version requires desc file-type))) + (if (> (car contents) package-archive-version) + (error "Unrecognized archive version %d" (car contents))) + (let ((elt (assq pkg-name (cdr contents)))) + (if elt + (if (package-version-compare split-version + (package-desc-vers (cdr elt)) + '<=) + (error "New package has smaller version: %s" pkg-version) + (setcdr elt new-desc)) + (setq contents (cons (car contents) + (cons (cons pkg-name new-desc) + (cdr contents)))))) + + ;; Now CONTENTS is the updated archive contents. Upload + ;; this and the package itself. For now we assume ELPA is + ;; writable via file primitives. + (let ((print-level nil) + (print-length nil)) + (write-region (concat (pp-to-string contents) "\n") + nil + (concat package-archive-upload-base + "archive-contents"))) + + ;; If there is a commentary section, write it. + (when commentary + (write-region commentary nil + (concat package-archive-upload-base + (symbol-name pkg-name) "-readme.txt"))) + + (set-buffer pkg-buffer) + (kill-buffer buffer) + (write-region (point-min) (point-max) + (concat package-archive-upload-base + file-name "-" pkg-version + "." extension) + nil nil nil 'excl) + + ;; Write a news entry. + (package--update-news (concat file-name "." extension) + pkg-version desc) + + ;; special-case "package": write a second copy so that the + ;; installer can easily find the latest version. + (if (string= file-name "package") + (write-region (point-min) (point-max) + (concat package-archive-upload-base + file-name "." extension) + nil nil nil 'ask))))))) + +(defun package-upload-buffer () + "Upload a single .el file to ELPA from the current buffer." + (interactive) + (save-excursion + (save-restriction + ;; Find the package in this buffer. + (let ((pkg-info (package-buffer-info))) + (package-upload-buffer-internal pkg-info "el"))))) + +(defun package-upload-file (file) + (interactive "fPackage file name: ") + (with-temp-buffer + (insert-file-contents-literally file) + (let ((info (cond + ((string-match "\\.tar$" file) (package-tar-file-info file)) + ((string-match "\\.el$" file) (package-buffer-info)) + (t (error "Unrecognized extension `%s'" + (file-name-extension file)))))) + (package-upload-buffer-internal info (file-name-extension file))))) + +(defun package-gnus-summary-upload () + "Upload a package contained in the current *Article* buffer. +This should be invoked from the gnus *Summary* buffer." + (interactive) + (save-excursion + (set-buffer gnus-article-buffer) + (package-upload-buffer))) + +(defun package--download-one-archive (file) + "Download a single archive file and cache it locally." + (let ((buffer (url-retrieve-synchronously + (concat package-archive-base file)))) + (save-excursion + (set-buffer buffer) + (package-handle-response) + (re-search-forward "^$" nil 'move) + (forward-char) + (delete-region (point-min) (point)) + (setq buffer-file-name (concat (file-name-as-directory package-user-dir) + file)) + (let ((version-control 'never)) + (save-buffer)) + (kill-buffer buffer)))) + +(defun package-refresh-contents () + "Download the ELPA archive description if needed. +Invoking this will ensure that Emacs knows about the latest versions +of all packages. This will let Emacs make them available for +download." + (interactive) + (package--download-one-archive "archive-contents") + (package--download-one-archive "builtin-packages") + (package-read-archive-contents)) + +(defun package-initialize () + "Load all packages and activate as many as possible." + (setq package-obsolete-alist nil) + (package-load-all-descriptors) + (package-read-archive-contents) + ;; Try to activate all our packages. + (mapc (lambda (elt) + (package-activate (car elt) (package-desc-vers (cdr elt)))) + package-alist)) + + + +;;;; Package menu mode. + +(defvar package-menu-mode-map nil + "Local keymap for `package-menu-mode' buffers.") + +(unless package-menu-mode-map + (setq package-menu-mode-map (make-keymap)) + (suppress-keymap package-menu-mode-map) + (define-key package-menu-mode-map "q" 'quit-window) + (define-key package-menu-mode-map "n" 'next-line) + (define-key package-menu-mode-map "p" 'previous-line) + (define-key package-menu-mode-map "u" 'package-menu-mark-unmark) + (define-key package-menu-mode-map "\177" 'package-menu-backup-unmark) + (define-key package-menu-mode-map "d" 'package-menu-mark-delete) + (define-key package-menu-mode-map "i" 'package-menu-mark-install) + (define-key package-menu-mode-map "g" 'package-menu-revert) + (define-key package-menu-mode-map "r" 'package-menu-refresh) + (define-key package-menu-mode-map "~" + 'package-menu-mark-obsolete-for-deletion) + (define-key package-menu-mode-map "x" 'package-menu-execute) + (define-key package-menu-mode-map "h" 'package-menu-quick-help) + (define-key package-menu-mode-map "?" 'package-menu-view-commentary) + ) + +(defvar package-menu-sort-button-map + (let ((map (make-sparse-keymap))) + (define-key map [header-line mouse-1] 'package-menu-sort-by-column) + (define-key map [follow-link] 'mouse-face) + map) + "Local keymap for package menu sort buttons.") + +(put 'package-menu-mode 'mode-class 'special) + +(defun package-menu-mode () + "Major mode for browsing a list of packages. +Letters do not insert themselves; instead, they are commands. +\\<package-menu-mode-map> +\\{package-menu-mode-map}" + (kill-all-local-variables) + (use-local-map package-menu-mode-map) + (setq major-mode 'package-menu-mode) + (setq mode-name "Package Menu") + (setq truncate-lines t) + (setq buffer-read-only t) + ;; Support Emacs 21. + (if (fboundp 'run-mode-hooks) + (run-mode-hooks 'package-menu-mode-hook) + (run-hooks 'package-menu-mode-hook))) + +(defun package-menu-refresh () + "Download the ELPA archive. +This fetches the file describing the current contents of +the Emacs Lisp Package Archive, and then refreshes the +package menu. This lets you see what new packages are +available for download." + (interactive) + (package-refresh-contents) + (package-list-packages-internal)) + +(defun package-menu-revert () + "Update the list of packages." + (interactive) + (package-list-packages-internal)) + +(defun package-menu-mark-internal (what) + (unless (eobp) + (let ((buffer-read-only nil)) + (beginning-of-line) + (delete-char 1) + (insert what) + (forward-line)))) + +;; fixme numeric argument +(defun package-menu-mark-delete (num) + "Mark a package for deletion and move to the next line." + (interactive "p") + (package-menu-mark-internal "D")) + +(defun package-menu-mark-install (num) + "Mark a package for installation and move to the next line." + (interactive "p") + (package-menu-mark-internal "I")) + +(defun package-menu-mark-unmark (num) + "Clear any marks on a package and move to the next line." + (interactive "p") + (package-menu-mark-internal " ")) + +(defun package-menu-backup-unmark () + "Back up one line and clear any marks on that package." + (interactive) + (forward-line -1) + (package-menu-mark-internal " ") + (forward-line -1)) + +(defun package-menu-mark-obsolete-for-deletion () + "Mark all obsolete packages for deletion." + (interactive) + (save-excursion + (goto-char (point-min)) + (forward-line 2) + (while (not (eobp)) + (if (looking-at ".*\\s obsolete\\s ") + (package-menu-mark-internal "D") + (forward-line 1))))) + +(defun package-menu-quick-help () + "Show short key binding help for package-menu-mode." + (interactive) + (message "n-ext, i-nstall, d-elete, u-nmark, x-ecute, r-efresh, h-elp")) + +(defun package-menu-view-commentary () + "Display information about this package. +For single-file packages, shows the commentary section from the header. +For larger packages, shows the README file." + (interactive) + (let* (start-point ok + (pkg-name (package-menu-get-package)) + (buffer (url-retrieve-synchronously (concat package-archive-base + pkg-name + "-readme.txt")))) + (with-current-buffer buffer + ;; FIXME: it would be nice to work with any URL type. + (setq start-point url-http-end-of-headers) + (setq ok (eq (url-http-parse-response) 200))) + (let ((new-buffer (get-buffer-create "*Package Info*"))) + (with-current-buffer new-buffer + (let ((buffer-read-only nil)) + (erase-buffer) + (insert "Package information for " pkg-name "\n\n") + (if ok + (insert-buffer-substring buffer start-point) + (insert "This package does not have a README file or commentary comment.\n")) + (goto-char (point-min)) + (view-mode))) + (display-buffer new-buffer t)))) + +;; Return the name of the package on the current line. +(defun package-menu-get-package () + (save-excursion + (beginning-of-line) + (if (looking-at ". \\([^ \t]*\\)") + (match-string 1)))) + +;; Return the version of the package on the current line. +(defun package-menu-get-version () + (save-excursion + (beginning-of-line) + (if (looking-at ". [^ \t]*[ \t]*\\([0-9.]*\\)") + (match-string 1)))) + +(defun package-menu-get-status () + (save-excursion + (if (looking-at ". [^ \t]*[ \t]*[^ \t]*[ \t]*\\([^ \t]*\\)") + (match-string 1) + ""))) + +(defun package-menu-execute () + "Perform all the marked actions. +Packages marked for installation will be downloaded and +installed. Packages marked for deletion will be removed. +Note that after installing packages you will want to restart +Emacs." + (interactive) + (goto-char (point-min)) + (forward-line 2) + (while (not (eobp)) + (let ((cmd (char-after)) + (pkg-name (package-menu-get-package)) + (pkg-vers (package-menu-get-version)) + (pkg-status (package-menu-get-status))) + (cond + ((eq cmd ?D) + (when (and (string= pkg-status "installed") + (string= pkg-name "package")) + ;; FIXME: actually, we could be tricky and remove all info. + ;; But that is drastic and the user can do that instead. + (error "Can't delete most recent version of `package'")) + ;; Ask for confirmation here? Maybe if package status is ""? + ;; Or if any lisp from package is actually loaded? + (message "Deleting %s-%s..." pkg-name pkg-vers) + (package-delete pkg-name pkg-vers) + (message "Deleting %s-%s... done" pkg-name pkg-vers)) + ((eq cmd ?I) + (package-install (intern pkg-name))))) + (forward-line)) + (package-menu-revert)) + +(defun package-print-package (package version key desc) + (let ((face + (cond ((eq package 'emacs) 'font-lock-builtin-face) + ((string= key "available") 'default) + ((string= key "installed") 'font-lock-comment-face) + (t ; obsolete, but also the default. + ; is warning ok? + 'font-lock-warning-face)))) + (insert (propertize " " 'font-lock-face face)) + (insert (propertize (symbol-name package) 'font-lock-face face)) + (indent-to 20 1) + (insert (propertize (package-version-join version) 'font-lock-face face)) + (indent-to 30 1) + (insert (propertize key 'font-lock-face face)) + ;; FIXME: this 'when' is bogus... + (when desc + (indent-to 41 1) + (insert (propertize desc 'font-lock-face face))) + (insert "\n"))) + +(defun package-list-maybe-add (package version status description result) + (let ((elt (assoc (cons package version) result))) + (unless elt + (setq result (cons (list (cons package version) status description) + result)))) + result) + +;; This decides how we should sort; nil means by package name. +(defvar package-menu-sort-key nil) + +(defun package-list-packages-internal () + (package-initialize) ; FIXME: do this here? + (with-current-buffer (get-buffer-create "*Packages*") + (setq buffer-read-only nil) + (erase-buffer) + (let ((info-list)) + (mapc (lambda (elt) + (setq info-list + (package-list-maybe-add (car elt) + (package-desc-vers (cdr elt)) + ;; FIXME: it turns out to + ;; be tricky to see if + ;; this package is + ;; presently activated. + ;; That is lame! + "installed" + (package-desc-doc (cdr elt)) + info-list))) + package-alist) + (mapc (lambda (elt) + (setq info-list + (package-list-maybe-add (car elt) + (package-desc-vers (cdr elt)) + "available" + (package-desc-doc (cdr elt)) + info-list))) + package-archive-contents) + (mapc (lambda (elt) + (mapc (lambda (inner-elt) + (setq info-list + (package-list-maybe-add (car elt) + (package-desc-vers + (cdr inner-elt)) + "obsolete" + (package-desc-doc + (cdr inner-elt)) + info-list))) + (cdr elt))) + package-obsolete-alist) + (let ((selector (cond + ((string= package-menu-sort-key "Version") + ;; FIXME this doesn't work. + #'(lambda (e) (cdr (car e)))) + ((string= package-menu-sort-key "Status") + #'(lambda (e) (car (cdr e)))) + ((string= package-menu-sort-key "Description") + #'(lambda (e) (car (cdr (cdr e))))) + (t ; "Package" is default. + #'(lambda (e) (symbol-name (car (car e)))))))) + (setq info-list + (sort info-list + (lambda (left right) + (let ((vleft (funcall selector left)) + (vright (funcall selector right))) + (string< vleft vright)))))) + (mapc (lambda (elt) + (package-print-package (car (car elt)) + (cdr (car elt)) + (car (cdr elt)) + (car (cdr (cdr elt))))) + info-list)) + (goto-char (point-min)) + (current-buffer))) + +(defun package-menu-sort-by-column (&optional e) + "Sort the package menu by the last column clicked on." + (interactive (list last-input-event)) + (if e (mouse-select-window e)) + (let* ((pos (event-start e)) + (obj (posn-object pos)) + (col (if obj + (get-text-property (cdr obj) 'column-name (car obj)) + (get-text-property (posn-point pos) 'column-name)))) + (setq package-menu-sort-key col)) + (package-list-packages-internal)) + +(defun package--list-packages () + "Display a list of packages. +Helper function that does all the work for the user-facing functions." + (with-current-buffer (package-list-packages-internal) + (package-menu-mode) + ;; Set up the header line. + (setq header-line-format + (mapconcat + (lambda (pair) + (let ((column (car pair)) + (name (cdr pair))) + (concat + ;; Insert a space that aligns the button properly. + (propertize " " 'display (list 'space :align-to column) + 'face 'fixed-pitch) + ;; Set up the column button. + (if (string= name "Version") + name + (propertize name + 'column-name name + 'help-echo "mouse-1: sort by column" + 'mouse-face 'highlight + 'keymap package-menu-sort-button-map))))) + ;; We take a trick from buff-menu and have a dummy leading + ;; space to align the header line with the beginning of the + ;; text. This doesn't really work properly on Emacs 21, + ;; but it is close enough. + '((0 . "") + (2 . "Package") + (20 . "Version") + (30 . "Status") + (41 . "Description")) + "")) + + ;; It's okay to use pop-to-buffer here. The package menu buffer + ;; has keybindings, and the user just typed 'M-x + ;; package-list-packages', suggesting that they might want to use + ;; them. + (pop-to-buffer (current-buffer)))) + +(defun package-list-packages () + "Display a list of packages. +Fetches the updated list of packages before displaying. +The list is displayed in a buffer named `*Packages*'." + (interactive) + (package-refresh-contents) + (package--list-packages)) + +(defun package-list-packages-no-fetch () + "Display a list of packages. +Does not fetch the updated list of packages before displaying. +The list is displayed in a buffer named `*Packages*'." + (interactive) + (package--list-packages)) + +;; Make it appear on the menu. +(define-key-after menu-bar-options-menu [package] + '(menu-item "Manage Packages" package-list-packages + :help "Install or uninstall additional Emacs packages")) + + + +(eval-when-compile + (require 'reporter)) + +(defun package-report-bug () + "Submit a bug report for package.el via email." + (interactive) + (require 'reporter) + (reporter-submit-bug-report + package-el-maintainer + (concat "package.el " package-el-version) + '(package-archive-base + package-archive-version + package-archive-contents + package-user-dir + package-directory-list + package-alist + package-activated-list + package-obsolete-alist))) + +(provide 'package) + +;;; package.el ends here diff --git a/elisp/erbot/.cvsignore b/elisp/erbot/.cvsignore new file mode 100644 index 0000000..f85ee5c --- /dev/null +++ b/elisp/erbot/.cvsignore @@ -0,0 +1,2 @@ +{arch} +.arch-ids diff --git a/elisp/erbot/AUTHORS b/elisp/erbot/AUTHORS new file mode 100644 index 0000000..54c0537 --- /dev/null +++ b/elisp/erbot/AUTHORS @@ -0,0 +1,40 @@ +Maintainers: + +Savannah Admins: + Name (username) <email> + --------------------------------------------------- + D. Goel (deego) <deego@gnufans.org> + Michael Olson (mwolson) <mwolson@gnu.org> + Vivek Dasmohapatra (fledermaus) <vivek@etla.org> + +Savannah Members: + Name (username) <email> + --------------------------------------------------- + Sebastian Freundt (hroptatyr) <freundt@math.TU-Berlin.DE> + Jose E Marchesi (jemarch) + Pete Kazmier (pkazmier) + Taylor R Campbell (riastradh) + Yann Hodique (sigma) + +Other Contributors: + Name (irc nick) <email> + --------------------------------------------------- + Alejandro Benitez <benitezalejandrogm@gmail.com> + Alex Schroeder (kensanata) + Brian Templeton (bpt) + Damien Elmes (resolve) + David Edmunston <dme@dme.org> + Dheeraj Buduru (dbuduru) + Enrico Bandiera + Grant Bowman (grantbow) + J. Michael Dupont (mdupont) + Jorgen Schaefer (forcer) + Lawrence Mitchell (lawrence) + Luis Fernandes (e1f) + Mario Lang (delYsid) + +(If we have left someone out, apologies: If you have commit privileges, + please add them - If not, please ask an admin or member) +==================================================== + +Last modified: Wed 2009-09-30 23:48:37 +0100 (fledermaus) diff --git a/elisp/erbot/COPYING b/elisp/erbot/COPYING new file mode 100644 index 0000000..94a9ed0 --- /dev/null +++ b/elisp/erbot/COPYING @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/> + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + <one line to give the program's name and a brief idea of what it does.> + Copyright (C) <year> <name of author> + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see <http://www.gnu.org/licenses/>. + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + <program> Copyright (C) <year> <name of author> + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +<http://www.gnu.org/licenses/>. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +<http://www.gnu.org/philosophy/why-not-lgpl.html>. diff --git a/elisp/erbot/CVS/Entries b/elisp/erbot/CVS/Entries new file mode 100644 index 0000000..14b11ad --- /dev/null +++ b/elisp/erbot/CVS/Entries @@ -0,0 +1,41 @@ +/.cvsignore/1.1/Thu Jan 5 00:15:39 2006// +/AUTHORS/1.16/Wed Sep 30 22:51:34 2009// +/COPYING/1.2/Fri Nov 23 16:31:58 2007// +/ChangeLog/1.69/Thu Dec 6 16:25:41 2007// +/HISTORY.txt/1.6/Wed May 10 21:22:37 2006// +/Makefile/1.2/Thu Aug 11 23:11:26 2005// +/README.txt/1.13/Sun Jul 22 23:26:03 2007// +/erball.el/1.33/Mon Aug 21 18:33:01 2006// +/erbbdb.el/1.9/Fri Nov 23 16:31:58 2007// +/erbc-backquote.el/1.1/Fri Aug 20 18:55:04 2004// +/erbc.el/1.131/Sat Sep 26 21:26:39 2009// +/erbc2.el/1.26/Fri Nov 23 16:31:58 2007// +/erbc3.el/1.30/Fri Nov 23 16:31:58 2007// +/erbc4.el/1.39/Fri Nov 23 16:31:58 2007// +/erbc5.el/1.19/Fri Nov 23 16:31:59 2007// +/erbc6.el/1.11/Fri Nov 23 16:31:59 2007// +/erbcompat.el/1.7/Fri Nov 23 16:31:59 2007// +/erbcountry.el/1.3/Wed Apr 6 16:49:49 2005// +/erbcspecial.el/1.9/Fri Nov 23 16:31:59 2007// +/erbdata.el/1.5/Fri Nov 23 16:31:59 2007// +/erbedit.el/1.6/Fri Nov 23 16:31:59 2007// +/erbeng.el/1.18/Fri Nov 23 16:31:59 2007// +/erbforget.el/1.12/Fri Nov 23 16:31:59 2007// +/erbim.el/1.7/Wed Apr 11 11:59:27 2007// +/erbjavadoc.el/1.8/Fri Nov 23 16:31:59 2007// +/erbkarma.el/1.8/Fri Nov 23 16:31:59 2007// +/erblisp.el/1.17/Fri Nov 23 16:31:59 2007// +/erblog.el/1.6/Fri Nov 23 16:31:59 2007// +/erbmerge.el/1.3/Fri Nov 23 16:31:59 2007// +/erbmsg.el/1.26/Fri Nov 23 16:31:59 2007// +/erbot-lispy.el/1.7/Thu Apr 20 18:34:04 2006// +/erbot.el/1.61/Wed Sep 30 23:33:47 2009// +/erbp.el/1.4/Fri Nov 23 16:31:59 2007// +/erbrss.el/1.4/Sat Jan 1 16:31:21 2005// +/erbtrain.el/1.19/Fri Nov 23 16:31:59 2007// +/erbtranslate.el/1.24/Sat Sep 26 21:35:47 2009// +/erbunlisp.el/1.6/Fri Nov 23 16:31:59 2007// +/erburl.el/1.5/Fri Nov 23 16:31:59 2007// +/erbutils.el/1.34/Sat Sep 26 21:16:33 2009// +/erbwiki.el/1.23/Fri Nov 23 16:31:59 2007// +D diff --git a/elisp/erbot/CVS/Entries.Log b/elisp/erbot/CVS/Entries.Log new file mode 100644 index 0000000..4201a0f --- /dev/null +++ b/elisp/erbot/CVS/Entries.Log @@ -0,0 +1,2 @@ +A D/contrib//// +A D/examples//// diff --git a/elisp/erbot/CVS/Repository b/elisp/erbot/CVS/Repository new file mode 100644 index 0000000..3bfa306 --- /dev/null +++ b/elisp/erbot/CVS/Repository @@ -0,0 +1 @@ +erbot diff --git a/elisp/erbot/CVS/Root b/elisp/erbot/CVS/Root new file mode 100644 index 0000000..efd54f4 --- /dev/null +++ b/elisp/erbot/CVS/Root @@ -0,0 +1 @@ +:pserver:anonymous@cvs.savannah.nongnu.org:/sources/erbot diff --git a/elisp/erbot/CVS/Template b/elisp/erbot/CVS/Template new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/elisp/erbot/CVS/Template diff --git a/elisp/erbot/ChangeLog b/elisp/erbot/ChangeLog new file mode 100644 index 0000000..0af41f3 --- /dev/null +++ b/elisp/erbot/ChangeLog @@ -0,0 +1,484 @@ +2007-12-06 D. Goel <deego3@gmail.com> + + * erbc.el (fsi-replace-regexp): fix call to `error'. + (fsi-merge-generic): Ditto. + (fsi-mv): " + (fsi-replace-string): " + and many other functions and files: Ditto. + +2007-11-23 Dave Goel <deego@gnufans.org> + + * COPYING: Replace by GPL v. 3 + + * erbot.el and all other files: Change GPL v. 2 to 3. + +2007-07-22 Michael Olson <mwolson@gnu.org> + + * README.txt: Mention examples/dotemacs-mybot. + + * examples/dotemacs-mybot: New file that is the example .emacs for + the bot. + +2007-07-19 Michael Olson <mwolson@gnu.org> + + * erbot.el (erbot-reply): Don't force the message through without + flood protection. Since ERC 5.1, ERC has very good flood + protection, so make use of it. + +2007-04-11 Vivek Dasmohapatra <vivek@etla.org> + + * erbim.el (fs-unicode-describe): add usage instructions + (erbim-search-by-description): search for unicode characters by + description. + (fs-unicode-find): bot-ui wrapper for erbim-search-by-description + including usage message. + (erbim-name-by-codepoint): changed output format to use #xXXX + +2007-01-28 Vivek Dasmohapatra <vivek@etla.org> + + * erbot.el (erbot-join-servers): `erc' takes :keyword style + parameters in emacs22, the old argument list no longer works. + Work out which erc version we're using and alter the call + appropriately. + +2007-01-27 Vivek Dasmohapatra <vivek@etla.org> + + * erbutils.el (erbutils-describe-variable): help-button-xref + has changed in emacs22, make this function work with it. + +2006-11-28 Michael Olson <mwolson@gnu.org> + + * erbot.el (erbot-join-servers): Make this work with the ERC + development branch. + +2006-09-28 D Goel <deego@gnufans.org> + + * erbc.el (fsi-describe-from-english): smarter self search + (fsi-generalize-search-term): new, for above. + +2006-08-21 Michael Olson <mwolson@gnu.org> + + * erbot.el (erbot-install): Remove check for erc-backend-version, + since it no longer exists. Use featurep instead. This fixes a + failure to join channels issue with the ERC development branch. + +2006-05-18 Vivek Dasmohapatra <vivek@etla.org> + + * erbtranslate.el (fsi-translate): If we can't make sense + of the call (not enough arguments) emit a usage message. + +2006-05-17 Michael Olson <mwolson@gnu.org> + + * contrib/translate.el (translate-load-pairs): Docfix. + + * erbtranslate.el (fsi-translate-list-services): Use + translate-program, not erbn-translate-program, since the latter + does not exist. + +2006-05-12 Vivek Dasmohapatra <vivek@etla.org> + + * contrib/translate.el: the symbol -> string coercion is not + required for arguments to translate.el, that's something + specific to user-visible erbot functions. + + * erbtranslate.el: most translation code moved to translate.el + fsi-translate-web-page temporarily disabled till I've tested + it a bit more and made the implementation a little smarter + than it currently is. (It should check ti see if a web page + service is actualy available) + +2006-05-10 D Goel <deego@gnufans.org> + + * erbtranslate.el: update authors + +2006-05-10 Vivek Dasmohapatra <vivek@etla.org> + + * erbtranslate.el (fsi-translate-list-pairs): destination language + should also be searched for with a case insensitive predicate. + +2006-05-09 D Goel <deego@gnufans.org> + + * erbtranslate.el: update authors + +2006-05-09 Vivek Dasmohapatra <vivek@etla.org> + + * erbtranslate.el (fsi-translate-list-pairs): improved help, return + more information when < N pairs, where N is currently 20. (Always + return full list if both origin and destination are both supplied) + (erbtranslate-full-name): returns a "full name" for a language, + consisting of all its human-readable aliases. + (erbtranslate-unsupported-langs): list of languages emacs can't utf-8 + encode yet. + (fsi-translate): abort for non-unicodable languages like Arabic and + Hebrew. + (fsi-translate): Use full names of languages in error messages. + (fsi-translate-list-pairs): Use full names of languages in messages. + +2006-05-08 Vivek Dasmohapatra <vivek@etla.org> + + * erbtranslate.el (erbtranslate-parse-pair): parse the output of + erbn-translate-program --list-pairs. + (erbtranslate-load-pairs): load the map of available translations. + (fsi-translate-list-pairs): Alter this function so that it only lists + possible translations when both an origin and a destination language + have been specified. Otherwise just tells the user how many matching + language pairs there are. + (fsi-translate-list-pairs): coerce the arguments into strings first. + (erbtranslate-parse-pair): some (one?) language codes are 3 letter. + I thought this was non-canonical but that's what translate returns, + so we must support it. + (erbtranslate-parse-pair): tidy up error message + (erbtranslate-req-to-pair): new. take the (possibly non-canonical) + language names from the user and map them to the canonical language + codes that translate expects. + (fsi-translate): map human-friendly language names in translation + request to canonical language codes. + (fsi-translate): use the coerced-strings, not the raw language args. + +2006-05-08 D Goel <deego@gnufans.org> + + * erbtranslate.el (erbn-translate-program): new. Make the program customizeable. + + + * contrib/shs.el: New shs.el, cleans up temporary files. + +2006-04-24 D Goel <deego@gnufans.org> + + * erbtranslate.el: DECLARE SAFE. Uses call-process now. + + * erball.el: require erbtranslate. + + * erbutils.el (erbutils-enabled-check): new function. + + * erbtranslate.el: revamp the file to make it secure, not yet final. + +2006-04-20 D Goel <deego@gnufans.org> + + * erbot.el (erbot-safe-p): Improve this function a bit. + (erbot-safe-nocontrol-p): new. + + * erbot-lispy.el (erbot-lispy-safe-p): change name from erbot-lispy-safep + + * erbot.el (erbot-safe-p): change name from erbot-safep + + * erbc.el (erbn-url-functions-p): new variable. Disallow url's + unless enabled here. Else potential freeze. + (erbn-internal-web-page-time): rename from the one below. + (fs-internal-web-page-time): rename to the one above + (erbn-url-functions-p): add bug discoverer's name in docstring. + (fsi-get-more-invocation-string): new function. + (fsi-limit-lines): Make the bot spit something useful instead of + ,more, when using weird erbn-char. + +2006-04-19 D Goel <deego@gnufans.org> + + * erbtranslate.el: fix minor doc typo + +2006-04-17 D Goel <deego@gnufans.org> + + * erbtranslate.el: adapted from indio's myerc.el. Work in + progress. INSECURE. DO NOT USE THIS FILE. + +2006-04-07 D Goel <deego@gnufans.org> + + * erbot.el (erbot-safe-make): Exception to control characters: + Allow \t + +2006-03-21 D Goel <deego@gnufans.org> + + * erbot.el (erbot-safe-make): new function. + (erbot-reply): call erbot-safe-make before replying. + +2006-02-28 Michael Olson <mwolson@gnu.org> + + * ChangeLog: Remove use of CVS Revision tag. + +2006-02-27 D Goel <deego@gnufans.org> + + * erbc2.el (fs-apply): SECURITY FIX! Also, disable when + paranoid. Ditto for funcall. + + * erbot.el (erbot-paranoid-p): Make this new variable a catchall + for security. t by default. No enablings like erbot-setf-p, + etc. will work unless this is non-nil. If this is non-nil, erbot + is paranoid, it will not allow apply, setf, funcall, sregex, + etc. even if the corresponding variables are turned on. + +2006-02-26 Michael Olson <mwolson@gnu.org> + + * erbc.el (fs-flame): Concat multiple arguments together to form + the flame target, unless there are only 2 arguments and the last + one is a number. In that case, we pick the specified flame. + +2006-01-10 D Goel <deego@gnufans.org> + + * erbc5.el (symbol-name): minor: provide this fs-function. + + +2006-01-05 Michael Olson <mwolson@gnu.org> + + * README.txt (NOTE): Add directions for getting the units file for + contrib/units.el. + + * contrib/units.el: Newly-added file that is recommended on the + ErbotInstallation page of emacswiki.org. + + +2006-01-01 D Goel <deego@gnufans.org> + + * erblisp.el (erblisp-check-args): Promote to a macro. This macro + first removes any arguments that can't be evalled. This happens, + when, for example, the user-defined function contained &optional, + &rest, etc. + + * erbot.el (erbot-remote): erc-coding-system-for-target was not + defined for older versions of erc. + +2005-12-31 Vivek Dasmohapatra <vivek@etla.org> + + * erbmsg.el (fs-memo): if a memo command was not recognised, + emit an error so we know it happened. + (fs-memos): If someone had no memos, return the help-memo + text too - makes it easier for people to figure out how it + all works. + +2005-12-30 Vivek Dasmohapatra <vivek@etla.org> + + * erbot.el (erbot-remote): Decode the incoming data properly + paying attention to erc's inbound coding system. + (erbot-reply): Now that the inbound data is (hopefully) cleanly + decoded we shouldn't need to force the outbound coding. + In emacs21, mule-ucs may be required for this to work. + +2005-11-10 D Goel <deego@gnufans.org> + + * erbot.el (erbot-safep): Make a minor change, to try to render + this function live up to its name: make it deem any newlines + unsafe. Because of the way the engine works, this change has no + effect on erbot at this time. + (erbot-safep): minor correction to last change. + +2005-11-09 Michael Olson <mwolson@gnu.org> + + * erbot.el (erbot-reply): Make erbot-safep check each line of the + split reply. Split the string on both \n and \r. Together, this + fixes an exploit in user-defined functions, which involved + returning a string like "^Mquit". + +2005-11-08 Michael Olson <mwolson@gnu.org> + + * erblisp.el (erblisp-max-list-length): New option that determines + how long a sand-boxed list or expression may be. + (erblisp-safe-length): New function that checks the given list to + make sure it isn't too long. It's able to handle nested lists as + well. + (erblisp-check-args): New function that calls erblisp-safe-length + with the correct args. + (erblisp-sandbox): Use erblisp-check-args. + + * erbc3.el (fsi-defun): Add erblisp-check-args invocation to each + newly-created user function. + +2005-10-12 Michael Olson <mwolson@gnu.org> + + * erbot.el (erbot-join-servers): Use fboundp check; + erc-compute-port is a function. + +2005-10-05 D Goel <deego@gnufans.org> + + * erbot.el (erbot-join-servers): `erc-compute-port' seems to be + undefined for my older ERC (4.0). So, I + reverted to old behavior when it is undefined. Did I do it right? + +2005-10-05 Michael Olson <mwolson@gnu.org> + + * erbot.el (erbot-join-servers): Call `erc-compute-port' instead + of using the value of `erc-port', since by default erc-port is + nil. + +2005-09-02 D Goel <deego@gnufans.org> + + * .*.el: Get rid of all string properties everywhere, especially + right at the source, for extra security. + + * erbc.el (fsi-read): minor: read-> read-from-string for more + safety + (erbn-read): new + (fsi-read-from-string): new + (fsi-describe-variable): use erbn-read for safety + (fsi-require): ditto + + * erbbdb.el (erbbdb-add): ditto + +2005-08-31 D Goel <deego@gnufans.org> + + * erbot.el (erbot-nickserv-p): Add auto-identify code, also enable + by default, see doc for erbot-nickserv-p for how to make changes + to your bot's .emacs. This is now required by freenode for + privmsgs to work. + (erbot-nickserv-p): Unde default behavior change. The default + behavior of erbot remains as xbefore: to *not*idontify by + default. + +2005-08-28 Michael Olson <mwolson@gnu.org> + + * contrib/wtf.el: Add to copyright notice. + (wtf-alist): Move FTBFS to the "Additional terms go here" section. + +2005-08-22 Jose E. Marchesi <jemarch@gnu.org> + + * contrib/haiku.el (fs-haiku): New file + +2005-08-16 D Goel <deego@gnufans.org> + + * contrib/wtf.el (wtf-alist): add ("FTBFS" . "failure to build from source") + +2005-08-15 Michael Olson <mwolson@gnu.org> + + * contrib/wtf.el: I received permission to receive these terms in + the public domain. + (wtf-alist): Add "TWAT". + (wtf-is): Fix Emacs21 issue. + +2005-08-11 Michael Olson <mwolson@gnu.org> + + * contrib/wtf.el (wtf-match-string-no-properties): New function + that is like match-string-no-properties, but works when that + function is not defined. + (wtf-get-term-at-point): New function that looks for term at + point. + (wtf-is): Make use of `wtf-get-term-at-point'. + + * Makefile (clean realclean distclean fullclean): Remove *~ files + in contrib directory. + +2005-07-09 Michael Olson <mwolson@gnu.org> + + * erball.el: Make sure that the user knows if bbdb cannot be + found. Otherwise they will get a non-working bot! + (erball-compilation-paths): Add path to BBDB. + +2005-07-02 Michael Olson <mwolson@gnu.org> + + * erball.el (erball-compiling-p): Use a custom routine instead of + `assoc' to detect "--compile-erbot" since the latter does not seem + to work on Emacs 22. + +2005-07-01 Michael Olson <mwolson@gnu.org> + + * erball.el (erball-compilation-paths-rel-to): New variable + populated by `--paths-rel-to ARG' on the emacs command line, + taking the value of ARG. + (erball-compiling-p): New variable that is non-nil when + `--compile-erbot' is included on the emacs command line. This is + used to indicate that we want to compile erbot from a Makefile. + (erball-compilation-paths): Elements to add to load-path when the + compilation flag, erball-compiling-p, is set. + (erball-files): Automatically populate this if erball-compiling-p + is set. + (erball-compile): If erball-compiling-p is set, use a simpler + routine. + + * Makefile: New file that allows erbot to be compiled and + installed. Edit the top of the file to indicate where to find + emacs and where to install the files. + + * README.txt (URL): Add brief mention of how to compile and + install erbot. + +2005-06-09 Michael Olson <mwolson@gnu.org> + + * contrib/wtf.el: New file that contains a list of acronyms in + `wtf-alist' and the `wtf-is' command to look up a definition. + + * erbtrain.el (erbtrain-utils-teach-acronyms): Use `wtf.el' to + teach the given bot some common acronyms. + +2005-04-28 D Goel <deego@gnufans.org> + + * erbc3.el (fsi-pf-load): Make this error msg more informative. + + * erbc5.el (fsi-ignore-errors-else-string): new. + +2005-04-01 D Goel <deego@gnufans.org> + + * erbc4.el (fsi-kick): Move from erbc.el to here. + + +2005-04-01 Michael Olson <mwolson@gnu.org> + + * erbot.el (erbot-doctor): Create separate doctor sessions for + each channel or query buffer so that responses make sense to the + user. + +2005-02-21 S Freundt <hroptatyr@gna.org> + + * erbmsg.el: (erbmsg-notify-msg-on-JOIN) [fix] add function set-alist for + compatibility to FSF emacsen + +2004-07-26 S Freundt <hroptatyr@gna.org> + + * erbmsg.el: (erbmsg-notify-msg-on-JOIN) + - fixed bug with last-access used for the first time + +2004-06-26 S Freundt <hroptatyr@gna.org> + + * erbmsg.el: + - added dump routines to dump message hash tables to hard disk + - added routines for restoring from dumped message files + - added interval within erbot does not notify on channel joins + - added erbmsg-new-msg-(pre|post)-hook + +2004-06-13 S Freundt <hroptatyr@gna.org> + + * erbot.el: added new var erbot-on-new-erc-p + and handlers for new erc-backend facilities. + + erc versions >1.660 use erc-backend.el to handle server + events. erbot is now aware of these new handlers by + determining the value `erbot-on-new-erc-p' when calling + `erbot-install'. + The new backend handlers' values are evaluated within + `erbot-remote' fun. + +2004-05-07 D Goel <deego@gnufans.org> + + * erbwiki.el: Security, add new functions. + + USING LINES < 0.3 FOR WIKI TRAINING WAS A SECURITY RISK, WE + THINK.. THOUGH WE HAVEN'T FIGURED OUT HOW TO EXPLOIT IT. + lines 0.3 and later fix that risk. + + Also add new functions to erbwiki.el suitable for parsing more + wikis. + + +2004-04-06 D Goel <deego@gnufans.org> + + * erbc.el (fs-kick): Kicking syntax different? remove nil? + +2004-03-28 D Goel <deego@gnufans.org> + + * erbcompat.el: name Sebastian as the author :) + + * erbwiki.el (erbwiki-get-fields): remove '... since not + recognized by xemacs + +2004-03-22 D Goel <deego@gnufans.org> + + * erball.el (noninteractive): dunnet should be required only for + noninteractive, else it starts a session! + +2004-03-21 D Goel <deego@gnufans.org> + + * erbc3.el: Redefine and move fs-setq here. + (fs-defun): This function was defined twice. Remove the first + definition. + + * erbc.el (fs-find-variable-internal): add cosmetic space. + (obarray): redefine and mv fs-setq to erbc3 + +2003-12-30 D Goel <deego@gnufans.org> + + * erbc.el (reverse): add fs-reverse + diff --git a/elisp/erbot/HISTORY.txt b/elisp/erbot/HISTORY.txt new file mode 100644 index 0000000..079bb72 --- /dev/null +++ b/elisp/erbot/HISTORY.txt @@ -0,0 +1,55 @@ +;; 2006-04-24 T14:02:53-0400 (Monday) D. Goel +Alejandro Benitez <benitezalejandrogm@gmail.com>, fledermaus and deego +provide natural language translation. + +;; 2005-12-31 T04:34:34-0500 (Saturday) D. Goel +Vivek Dasmohapatra fixes/fixing coding issues. + +;; 2005-08-11 T19:49:47-0400 (Thursday) D. Goel + +Michael Olson creates a Makefile, thus, for the first time, making the +notion of erbot becoming an installable package, look possible.. + + +;; 2005-06-04 T15:04:23-0400 (Saturday) D. Goel +Michael Olson provides function to train acronyms: + +M-x load-file ~/emacs-wiki-wtf.el + +M-: +(setq erbtrain-list + (mapcar (lambda (ref) + (concat "plugbot: " (car ref) + " is " (upcase-initials (cdr ref)))) + emacs-wiki-wtf-alist)) + +M-x erbtrain-resume +M-x idledo-start + + +or see M-x erbtrain-utils-teach-acronyms + +;;; 2005-06-04 T15:05:15-0400 (Saturday) D. Goel +Previous history here: +Summary in reverse order, IIRC: + + +<Please add here> + +erbot-lispy + +erc-robot (David Edmunston)-> erbot, + +==================================================== + +The idea for rr (russian roulette) came from e1f. + +The idea for answering questions not addressed to fsbot, like "foo?" +came from resolve. + +The idea for invoking the bot in the middle of sentences came from +resolve. + + + + diff --git a/elisp/erbot/Makefile b/elisp/erbot/Makefile new file mode 100644 index 0000000..e98e2d0 --- /dev/null +++ b/elisp/erbot/Makefile @@ -0,0 +1,40 @@ +.PHONY: all lisp contrib clean realclean distclean fullclean install dist +.PRECIOUS: %.elc + +EMACS = emacs +SITEFLAG = --no-site-file + +# Xemacs users will probably want the following settings. +#EMACS = xemacs +#SITEFLAG = -no-site-file + +# Installation options +# PREFIX is only used here. +PREFIX = /usr/local +ELISPDIR = $(PREFIX)/share/emacs/site-lisp/erbot + +all: lisp contrib + +lisp: + @$(EMACS) -q $(SITEFLAG) -batch --debug-init \ + -l erball.el \ + -f erball-compile --compile-erbot + +contrib: + @(cd contrib && \ + $(EMACS) -q $(SITEFLAG) -batch \ + -l ../erball.el \ + -f erball-compile \ + --paths-rel-to '../' --compile-erbot) + +clean realclean distclean fullclean: + -rm -f *.elc contrib/*.elc *~ contrib/*~ + +install: + install -d $(ELISPDIR) + install -m 0644 *.el *.elc $(ELISPDIR) + install -d $(ELISPDIR)/contrib + install -m 0644 contrib/*.el contrib/*.elc $(ELISPDIR)/contrib + +dist: distclean + (cd ..; tar cvzf ../erbot.tar.gz erbot) diff --git a/elisp/erbot/README.txt b/elisp/erbot/README.txt new file mode 100644 index 0000000..1d2540f --- /dev/null +++ b/elisp/erbot/README.txt @@ -0,0 +1,90 @@ +URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot for all erbot +information, and installation help. + + + +The files in the `contrib' directory are optional "third-party" +add-ons that are used for erbot. Not all of them are strictly +required. The versions here are provided for convenience, and are +also the versions known to work with erbot, but you might want to +fetch their latest versions from their respective authors' websites. + +The file `examples/dotemacs-mybot' is meant to be the bot's .emacs +file. Copy it to .emacs in your bot's home directory, and then make +any changes you like. + +NOTE: A data file for contrib/units.el may be obtained in Debian by +performing "apt-get install units", and adding + (setq units-dat-file "/usr/share/misc/units.dat") +to the bot's .emacs. + +To compile the erbot source, edit Makefile and run "make". To install +it, edit Makefile and run "make install". + + +==================================================== + +For developers: + + +Namespaces used by these files: fs-, fs.*-, erb.*- + + + +Next, we attempt to describe the various abbreviations and terms used +in this package. + + ++---------+------------------------------------------------------------+ +|botbbdb |Name of the bbdb database file used by the bots. | ++---------+------------------------------------------------------------+ +|erb |ErBot stands for erc robot, and started out from | +| |erc-robot.el. We named the new file erbot, and most | +| |namespaces start with erb. | ++---------+------------------------------------------------------------+ +| | | ++---------+------------------------------------------------------------+ +|erbc- |This referred to erbot-comands. Functions starting with this| +| |name were availabel to public to frob as they like. Same | +| |for variables. This was replaced by fs- | ++---------+------------------------------------------------------------+ +|erbnoc- |This is like erbc-, except that these commands are NOT | +| |available to the general public (at this time). This one is| +| |still in use, unlike fs-. These functions are NOT | +| |world-executable or world-writable, but are maintained | +| |alognside erbc- functions .. erbnoc meansd: erb - | +| |no-commands... We have now shortened it to erbn- | ++---------+------------------------------------------------------------+ +|erbn- |Shortening of erbnoc- | ++---------+------------------------------------------------------------+ +|fs- |fsbot is a popular instance of erbot. At some point, all | +| |erbc- prefixes were replaced by fs- for easier read. Thus, | +| |to reiterate, these functions are world-readable, weritable | +| |writable and executable. (The only exeptions are those that| +| |are internally converted from fsi-, which are converted to | +| |fs- with a special disabled property.) Summary: rwx for irc| +| |users. | ++---------+------------------------------------------------------------+ +|fsi- |Like fs- but these functions and variables are only | +| |world-readable and world-executable, but NOT world-writable.| +| |The "i" stands for immutable (or is it "internal"?). These | +| |functions are internally converted to fs- functionserbot | +| |usage through erbot-install-symbols. Summary: r-x for irc | +| |users. | ++---------+------------------------------------------------------------+ +|fsn- |This "fs NOT" would be the logical "---" counterpart for the| +| |fs.* prefixes above, butits similarity to fs will make | +| |reading difficult, so we stick with erbn- | ++---------+------------------------------------------------------------+ +|All other|.. are also ---, and the only difference from erbn- is | +|prefixes |aesthetical. | +| | | ++---------+------------------------------------------------------------+ +|fsbot | "Free software bot", an instance of fsbot. | ++---------+------------------------------------------------------------+ +| | | +| | | +| | | +| | | +| | | ++---------+------------------------------------------------------------+ diff --git a/elisp/erbot/contrib/CVS/Entries b/elisp/erbot/contrib/CVS/Entries new file mode 100644 index 0000000..0421465 --- /dev/null +++ b/elisp/erbot/contrib/CVS/Entries @@ -0,0 +1,20 @@ +/META-feeding-info-terms.el/1.2/Tue Jan 3 03:40:18 2006// +/README.txt/1.1/Mon May 8 04:11:26 2006// +/bash-quotes.el/1.2/Wed Sep 30 22:23:04 2009// +/faith.el/1.1/Thu Dec 16 01:44:34 2004// +/flame.el/1.1/Thu Dec 16 01:44:34 2004// +/geek.el/1.1/Thu Dec 16 01:44:34 2004// +/google.el/1.2/Wed Sep 30 22:23:04 2009// +/h4x0r.el/1.2/Wed Sep 30 22:23:04 2009// +/haiku.el/1.2/Wed Sep 30 22:23:04 2009// +/idledo.el/1.2/Wed Sep 30 22:23:04 2009// +/lines.el/1.1/Thu Dec 16 01:44:34 2004// +/mkback.el/1.2/Wed Sep 30 22:23:04 2009// +/oct.el/1.2/Wed Sep 30 22:23:04 2009// +/shs.el/1.3/Wed Sep 30 22:23:04 2009// +/soap.el/1.2/Wed Sep 30 22:23:04 2009// +/timerfunctions.el/1.2/Wed Sep 30 22:23:04 2009// +/translate.el/1.7/Wed Sep 30 22:23:04 2009// +/units.el/1.1/Thu Jan 5 18:52:02 2006// +/wtf.el/1.20/Wed Sep 30 22:23:04 2009// +D diff --git a/elisp/erbot/contrib/CVS/Repository b/elisp/erbot/contrib/CVS/Repository new file mode 100644 index 0000000..825b403 --- /dev/null +++ b/elisp/erbot/contrib/CVS/Repository @@ -0,0 +1 @@ +erbot/contrib diff --git a/elisp/erbot/contrib/CVS/Root b/elisp/erbot/contrib/CVS/Root new file mode 100644 index 0000000..efd54f4 --- /dev/null +++ b/elisp/erbot/contrib/CVS/Root @@ -0,0 +1 @@ +:pserver:anonymous@cvs.savannah.nongnu.org:/sources/erbot diff --git a/elisp/erbot/contrib/CVS/Template b/elisp/erbot/contrib/CVS/Template new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/elisp/erbot/contrib/CVS/Template diff --git a/elisp/erbot/contrib/META-feeding-info-terms.el b/elisp/erbot/contrib/META-feeding-info-terms.el new file mode 100644 index 0000000..df5584a --- /dev/null +++ b/elisp/erbot/contrib/META-feeding-info-terms.el @@ -0,0 +1,73 @@ +;; this helps prepare an erbtrain file from +;; http://www.emacswiki.org/emacs/info-ref.dat, see also +;; http://www.emacswiki.org/cgi-bin/wiki/EmacsWikiSuggestions +;; or google for emacswiki info ref for pertinent discussions. + +;; Author Alex Shroeder <alex@gnu.org> + +;; received from kensanata: +(defun meta-feeding-info-k () + (let (data (lines 0)) + (with-current-buffer (get-buffer "info-ref.dat") + (message "Parsing buffer...") + (goto-char (point-min)) + (while (re-search-forward "^\\(.*\\)\\(.*\\)" nil t) + (let ((term (match-string 1)) + (rest (match-string 2))) + (setq term (replace-regexp-in-string " " "_" term) + lines (1+ lines) + data (cons (cons term + (mapcar + (lambda (entry) + (car (split-string entry ""))) + (split-string rest ""))) + data))))) + (switch-to-buffer (get-buffer-create "info-ref-botsnack")) + (let ((count 0)) + (dolist (entry data) + (message "Preparing botsnack...%d%%" (/ (* 100 count) lines)) + (insert (format "%s is at %s" (car entry) (cadr entry))) + (newline) + (dolist (url (cddr entry)) + (insert (format "%s is also at %s" (car entry) url)) + (newline)))) + (message "Preparing botsnack...done"))) + +;;; 2006-01-02 T22:04:08-0500 (Monday) D. Goel +;; minor modifications to the above: +(defun meta-feeding-info-d () + (interactive) + (let (data (lines 0)) + (with-current-buffer (get-buffer "info-ref.dat") + (message "Parsing buffer...") + (goto-char (point-min)) + (while (re-search-forward "^\\(.*\\)\\(.*\\)" nil t) + (let ((term (match-string 1)) + (rest (match-string 2))) + (set-text-properties 0 (length term) nil term) + (set-text-properties 0 (length rest) nil rest) + (setq term (replace-regexp-in-string " " "_" term) + lines (1+ lines) + data (cons (cons term + (mapcar + (lambda (entry) + (car (split-string entry ""))) + (split-string rest ""))) + data))))) + (switch-to-buffer (get-buffer-create "info-ref-botsnack")) + (let ((count 0) attmp) + (dolist (entry data) + (setq attmp (format "at %s" (cadr entry))) + (message "Preparing botsnack...%d%%" (/ (* 100 count) lines)) + (insert (format "fsbot: (set-term %S %S)" (car entry) attmp)) + (newline) + (insert (format "fsbot: (set-also %S %S)" (car entry) attmp)) + (newline) + + (dolist (url (cddr entry)) + (insert (format "fsbot: (set-also %S %S)" (car entry) + (format "at %s" url)))) + (newline))) + (message "Preparing botsnack...done"))) + + diff --git a/elisp/erbot/contrib/README.txt b/elisp/erbot/contrib/README.txt new file mode 100644 index 0000000..913d2fa --- /dev/null +++ b/elisp/erbot/contrib/README.txt @@ -0,0 +1,7 @@ +;; 2006-05-08 T00:08:11-0400 (Monday) D. Goel + +Files in this directory are usually included here for user's +convenience, but may be developed elsewhere by their authors. Thus, +these files may not neccessarily their latest versions. + + diff --git a/elisp/erbot/contrib/bash-quotes.el b/elisp/erbot/contrib/bash-quotes.el new file mode 100644 index 0000000..a2ea28e --- /dev/null +++ b/elisp/erbot/contrib/bash-quotes.el @@ -0,0 +1,337 @@ +;;; bash.el --- bash.org interface + +;; Copyright (C) 2003 Free Software Foundation, Inc. + +;; Author: Ulrik Jensen <ulrik@qcom.dk> +;; Keywords: HTTP, bash, searching +;; Time-stamp: <2003-04-14 17:08:55 Administrator> +;; Version: 0.1 alpha :) + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; An interface for reading bash.org with Emacs +;; Requires http-get 1.0.8: +;; <http://www.emacswiki.org/cgi-bin/wiki.pl?HttpGet> + +;;; Code: + +(require 'http-get) + +;; URL's, for use later in the script +(defvar bash-get-quote-url "http://www.bash.org/?%id%" + "The URL to fetch to get a specific quote. + + %id% will be replaced with the specific id") + +(defvar bash-search-quotes-url + "http://bash.org/?search=%criteria%&sort=%sort%&show=%number%" + "The URL to search bash.org for quotes. + + %number% will be replaced with the max number of results + %sort% will be replaced with 1 or 2, with 1=id, and 2=rating +%criteria% will be replaced with the words to search for") + +(defvar bash-get-latest-url "http://www.bash.org/?latest" + "The URL to fetch to get the latest quotes from bash.org.") + +(defvar bash-get-top-rated-url "http://www.bash.org/?top" + "The URL to fetch to get the top 50 quotes from bash.org.") + +(defvar bash-get-next-top-rated-url "http://www.bash.org/?top2" + "The URL to fetch to get the top 50-100 quotes from bash.org.") + +(defvar bash-get-random-url "http://www.bash.org/?random" + "The URL to fetch to get 30 random quotes from bash.org.") + +(defvar bash-get-random-above-zero-url + "http://www.bash.org/?random2" + "The URL to fetch to get 30 random quotes, with rating > 0 from bash.org") + +;; Variable for holding the title of the requested page +(defvar bash-tmp-results-title "Search" + "A temporary variable that stores a title to insert in all *bash*-buffers") + +;; Buffer names +(defvar bash-buffer "*bash*" + "Name of the buffer used to read bash.org quotes in") + +(defvar bash-temp-buffer "*bash-tmp*" + "Name of the temporary buffer used to fetch and parse bash.org results") + +;; Regexps for parsing the html-output of bash.org +(defvar bash-mysql-down-regexp "<p>.*Sorry.*MySQL.*down" + "A regular expression used to check if bash.org's mysql deamon +is down, as often is the case.") + +(defvar bash-quote-regexp + "<p class=\"quote\">\\(.*?\\)</p><p class=\"qt\">\\(.*?\\)</p>" + "A regular expression used to parse the html-source of bash.org outputs. + +The first group is data about the quote, links, id, and votes. +The second group is the quote itself") + +(defvar bash-quote-data-regexp + (concat "<a href=\"\\?\\([0-9]*\\)\" title=\".*?" + "<a href=\"\\./\\?\\(.*?\\)\".*?</a>" + "(\\(-?[0-9]*\\))<a href=\"\\./\\?\\(.*?\\)\".*?" + "<a href=\"\\./\\?\\(.*?\\)\"") + "A regular expression used to parse the data-group of `bash-quote-regexp' + +The groups of this regular expressions should match the following: +1. The id of the quote on bash.org +2. The URI to vote positively +3. The number of votes the quote has received +4. The URI to vote negatively +6. The URI to flag for deletion") + +;; URL-generating functions +(defun bash-get-quote-url (id) + "Return the URL for a specific quote" + (replace-regexp-in-string "%id%" id bash-get-quote-url)) + +(defun bash-make-search-url (criteria sort number) + "Returns a URL to search bash.org for criteria" + (let* ((url (replace-regexp-in-string "%criteria%" (http-url-encode criteria 'iso-latin-1) bash-search-quotes-url)) + (url (replace-regexp-in-string "%sort%" sort url)) + (url (replace-regexp-in-string "%number%" (number-to-string number) url))) + url)) + +;; At some point, this should add faces as well +(defun bash-parse-single-quote (quote data) + "Parses the HTML of a single quote, and returns the appropriate output" + (unless (string-match bash-quote-data-regexp data) + (error "Data-field didn't match regexp!")) + (let* ((quoteid (match-string 1 data)) + (uplink (match-string 2 data)) + (votes (match-string 3 data)) + (downlink (match-string 4 data)) + (flag (match-string 5 data)) + ;; I really should put these into an alist or use + ;; a html-rendering function for it + (curquote (replace-regexp-in-string "<[/]?p[^>]*>" "" quote)) + (curquote (replace-regexp-in-string "<" "<" curquote)) + (curquote (replace-regexp-in-string ">" ">" curquote)) + (curquote (replace-regexp-in-string "<br />" "\n" curquote)) + (curquote (replace-regexp-in-string """ "\"" curquote)) + (curquote (replace-regexp-in-string " " " " curquote)) + (curquote (replace-regexp-in-string "&" "&" curquote))) + ;; Below is the visual output + (insert "Quote ") + (widget-create 'push-button + :notify `(lambda (&rest ignore) + (bash-specific-quote ,quoteid)) + (concat "#" quoteid)) + (insert " ") + (widget-create 'push-button + :notify `(lambda (&rest ignore) + (bash-process-request (concat "http://www.bash.org/?" ,uplink) "add a positive vote to " ,quoteid)) + "+") + (insert " (" votes ") ") + (widget-create 'push-button + :notify `(lambda (&rest ignore) + (bash-process-request (concat "http://www.bash.org/?" ,downlink) "add a negative vote to " ,quoteid)) + "-") + (insert " ") + (widget-create 'push-button + :notify `(lambda (&rest ignore) + (bash-process-request (concat "http://www.bash.org/?" ,flag) "flag " ,quoteid)) + "X") + (insert " ") + (widget-create 'push-button + :notify `(lambda (&rest ignore) + (bash-save-quote ,curquote ,quoteid)) + "Save quote") + (insert "\n" + "--------------------------------------------------------------------------------" + "\n" curquote "\n" + "--------------------------------------------------------------------------------" + "\n\n"))) + +(defun bash-parse (buffer) + "Parses the results from bash.org, in the bash-temp buffer, and adds them to BUFFER" + (set-buffer (get-buffer-create bash-temp-buffer)) + (let* ((buftext (buffer-substring (point-min) (point-max))) + (buftext (replace-regexp-in-string "\n" "" buftext)) + (buftext (replace-regexp-in-string "</pt>
?" "</pt>\n" buftext)) + (buftext (replace-regexp-in-string "
" "" buftext))) + (set-buffer buffer) + (insert "\n\n") + (cond + ;; If there are actually quotes in the output + ((string-match bash-quote-regexp buftext) + (while (string-match bash-quote-regexp buftext) + (let ((curdata (match-string 1 buftext)) + (curquote (match-string 2 buftext)) + (quotestart (string-match bash-quote-regexp buftext))) + (when curquote ; just a precaution.. shouldn't be necessary + (bash-parse-single-quote curquote curdata) + ;; delete the quote from the string, actually. this is a few chars + ;; short every time.. hope it doesn't matter though + (setq buftext (substring buftext (+ (length curquote) (length curdata) quotestart) nil)) + (setq quote-count (+ quote-count 1)))))) + ;; If the output tells us that the mysql-deamon is down + ((string-match bash-mysql-down-regexp buftext) + (insert "Bash.org's MySQL-deamon seems to be down at the moment.")) + ;; If none of the above, panic + (t + (insert "No results!"))))) + +(defun bash-insert-menubar () + "Inserts a widget-based menubar for navigating bash.org" + (widget-create 'push-button + :notify (lambda (&rest ignore) + (bash-random-30-quotes)) + "Random") + (insert " ") + (widget-create 'push-button + :notify (lambda (&rest ignore) + (bash-random-above-zero-quotes)) + "> 0") + (insert " Top ") + (widget-create 'push-button + :notify (lambda (&rest ignore) + (bash-top-50-quotes)) + "50") + (insert " ") + (widget-create 'push-button + :notify (lambda (&rest ignore) + (bash-top-50-100-quotes)) + "-100") + (insert " ") + (widget-create 'push-button + :notify (lambda (&rest ignore) + (bash-latest-quotes)) + "Latest") + (insert " ") + (widget-create 'push-button :notify (lambda (&rest ignore) (bury-buffer)) "Bury buffer") + (insert "\n" + "--------------------------------------------------------------------------------")) + +(defun bash-sentinel (process string) + "Sentinel for processing bash-results" + (kill-buffer (get-buffer-create bash-buffer)) + (let ((buffer (get-buffer-create bash-buffer))) + (set-buffer buffer) + (erase-buffer) + (goto-char 0) + (bash-insert-menubar) + (insert "\nBash Results - " bash-tmp-results-title "\n") + (let ((quote-count 0)) + (bash-parse buffer) + (insert "\n\n " (number-to-string quote-count) " quotes showed.")) + (pop-to-buffer buffer) + ;; Setup widget-minor-mode + ;; should always be called before setting a new major mode + ;; apparently also needs to be called before widget-minor-mode + (kill-all-local-variables) + (widget-minor-mode 1) + (widget-setup) + ;; Make the buffer read-only, no need to edit it + (setq buffer-read-only t) + ;; Bind some keys + (local-set-key "q" '(lambda() (interactive) (bash-cleanup-buffers))) + ;; (local-set-key "n" 'bash-next-quote) + ;; scroll to the top + (goto-char 0) + (kill-buffer (get-buffer-create bash-temp-buffer)))) + +;; For these to work, I might have to use http-1.1 +(defun bash-request-sentinel (process string) + "Sentinel for processing bash-results" + (let ((buffer (get-buffer-create bash-temp-buffer))) + (save-excursion + (set-buffer buffer) + ;; Check the result of the request, and message it + ;; (kill-buffer (get-buffer-create bash-temp-buffer)) + ))) + +(defun bash-cleanup-buffers () + "Removes all bash-related buffers" + (kill-buffer (get-buffer-create bash-buffer)) + (kill-buffer (get-buffer-create bash-temp-buffer))) + +(defun bash-process-url (url) + (http-get url nil 'bash-sentinel 1.0 bash-temp-buffer) + (message "Waiting for results from bash.org")) + +(defun bash-process-request (uri action id) + (http-get (concat "http://www.bash.org/?" uri) nil 'bash-request-sentinel 1.0 bash-temp-buffer) + (message "Attempting to %s quote #%s with bash.org" action id)) + +;; Entry points +;; -------------------------------------------------------------------------- +(defun bash-specific-quote (id) + "Downloads a specific quote from bash.org" + (interactive "sEnter quote-id: ") + (bash-process-url (bash-get-quote-url id))) + +(defun bash-latest-quotes () + "Downloads a specific quote from bash.org" + (interactive) + (setq bash-tmp-results-title "Latest quotes") + (bash-process-url bash-get-latest-url)) + +(defun bash-top-50-quotes () + "Downloads a specific quote from bash.org" + (interactive) + (setq bash-tmp-results-title "Top 50 quotes") + (bash-process-url bash-get-top-rated-url)) + +(defun bash-top-50-100-quotes () + "Downloads a specific quote from bash.org" + (interactive) + (setq bash-tmp-results-title "Top 50-100 quotes") + (bash-process-url bash-get-next-top-rated-url)) + +(defun bash-random-30-quotes () + "Downloads a specific quote from bash.org" + (interactive) + (setq bash-tmp-results-title "Random quotes") + (bash-process-url bash-get-random-url)) + +(defun bash-random-above-zero-quotes () + "Fetches random quotes from bash.org, all with ratings above zero" + (interactive) + (setq tmp-bash-results-title "Random quotes, rating > 0") + (bash-process-url bash-get-random-above-zero-url)) + +;; Saving a quote in a fortunedb file +(defun bash-save-quote (quote id) + "Saves a quote to a fortune-format file" + (let ((filename (read-file-name "Append to fortune-file: " ))) + (with-temp-buffer + (find-file filename) + (goto-char (point-max)) + (insert "\n%%\nfrom bash.org, quote #" id "\n" quote) + (save-buffer) + (kill-buffer (current-buffer))))) + +;; Searching bash.org +(defun bash-search-quote (criteria sort number) + "Searches bash.org for quote" + (interactive "sSearch for: \ncSort by number ('n') or rating ('r'): \nnNumber of results to return (25,50,75 or 100): ") + (unless (or (= sort ?n) (= sort ?r)) + (setq sort ?r)) ; sort by rating pr. default + (if (= sort ?n) + (setq sort "1") + (setq sort "2")) + (setq bash-tmp-results-title (concat "Searched for \"" criteria "\"")) + (bash-process-url (bash-make-search-url criteria sort number))) + +(provide 'bash-quotes) +;;; bash-quotes.el ends here
\ No newline at end of file diff --git a/elisp/erbot/contrib/faith.el b/elisp/erbot/contrib/faith.el new file mode 100644 index 0000000..bfa85d3 --- /dev/null +++ b/elisp/erbot/contrib/faith.el @@ -0,0 +1,566 @@ +;;; faith.el --- hepls spreading the true faith +;; Time-stamp: <2003-08-19 13:38:28 deego> +;; GPL'ed under GNU'S public license.. +;; Copyright (C) Deepak Goel 2000 +;; Emacs Lisp Archive entry +;; Filename: faith.el +;; Author: Deepak Goel <deego@glue.umd.edu> +;; Version: 1.9 + +(defconst faith-version "1.9" + "Version number of faith.el") + +;; This file is not (yet) part of GNU Emacs. + +;; WEBSITE: http://www.glue.umd.edu/~deego/emacspub/faith/ +;; for this file and for associated READMEs LOGFILEs etc.. + +;;; Copyright (C) Deepak Goel +;; AUTHORS: Deepak Goel (deego@glue.umd.edu) , +;; Robert Fenk <Robert.Fenk@gmx.de>, +;; Roberto Selbach Teixeira <teixeira@conectiva.com> +;; Remi Vanicat<vanicat@labri.u-bordeaux.fr> + +;; YOU ARE VERY WELCOME TO CONTRIBUTE TO FAITH. YOUR SUGGESTIONS OR +;; CONTRIBUTIONS OR CORRECTIONS WILL BE CONSIDERED VERY FAVORABLY, +;; AND WILL PROVE YOUR UTMOST DEVOTION TO HIM. Even minor +;; contributions to this holy work will earn you a name on the list +;; of authors. + +;; If you have been invited to become priest (author) of faith, +;; please send deego@glue.umd.edu an email agreeing to accept the +;; "GNU FREEness" of faith, and agreeing that if at any point in +;; future, you don't agree to sign the appropriate copyleft +;; agreement, deego@glue.umd.edu will remove you from the author's +;; list. You will be promptly listed as an author. + +;; Commentary: In this world of infidelity and blasphemy, +;; FAITH tries to reinforce faith in you. + +;;; QUICKSTART INSTALLATION FOR THOSE LOST: +;;; Drop faith.el somewhere in yr load-path, and add to your .emacs: +;;; (load "faith.el") +;;; then type M-x faith, and enjoy.. + + +;;; Code: +(defconst faith-false-quotes nil + "BLASPHEMOUS QUOTES. DON'T LOOK! +A variety of false quotes collected from various places. Collected so +that the false names can be replaced by the TRUE ONE.") + +(defvar faith-user-quotes nil + "*These are any additional quotes a user might like included.") + +(defvar faith-quotes-separator "\n__________________________\n\n" + "*The string whis is inserted before a quote.") + +(defvar faith-replacement-strings nil + "True Replacements for bad Gods and other words. +Is a list of REPLACEMENTS. Each replacement is a list of BADLIST and +GOODLIST. All matches from BADLIST will be replaced by a random word +from goodlist. For consistency, the random word chosen will be the +same for the entire quote.") + +(defvar faith-user-before-replacement-strings nil + "Will be appended before faith-replacement-strings. +Allow user to define their own replacements, and together with +faith-user-after-replacement-strings, to completely edit the default +replacement-strings.. in many many novel ways the wise user may come +up with.. O user, from now on, you may customize your faith, should u +like to.. +Also see faith-user-after-replacement-strings") + +(defvar faith-user-after-replacement-strings nil + "Will be appended after faith-replacement-strings. +Allow user to define their own replacements. +Also see faith-user-before-replacement-strings") + +;; THE 'false-quotes have been picked out of books whose authors are +;; not likely to be in a position to object to the same. Current +;; sources: +;; Bible +;; Koran + + +;;;###autoload +(defun faith-insert (&rest args) + "Insert a quote right here, right now, in the current buffer" + (interactive) + (insert (apply 'faith-quote args))) + + +(defvar faith-fill-column 70) + +;; You might think some users might find no need for this +;; 'faith function. But ask me! It makes testing so easier.. +;;;###autoload +(defun faith () + "Switch to buffer *faith* and insert faith-snippets there." + (interactive) + (if (equal (buffer-name) "*faith*") + "" + (progn + (get-buffer-create "*faith*") + (switch-to-buffer "*faith*"))) + (let ((go-this-time t)) + (while go-this-time + (goto-char (point-max)) + (insert faith-quotes-separator (faith-quote)) + (goto-char (point-max)) + (recenter) + (setq fill-column faith-fill-column) + (call-interactively 'fill-paragraph) + (if (y-or-n-p "Care for more wise words? ") + nil + (setq go-this-time nil)))) + (message "Use M-x faith-correct on your own documents in order to correct them.")) + +;;;###autoload +(defun faith-quote (&optional quotes leave-alone-p ) + "Helps reinforce and spread faith in the ONE TRUE EDITOR. +Returns a randomly chosen snippet, which helps you along your search +for truth. If the argument QUOTES is supplied, it is the one used +instead of using the default source for quotes. If LEAVE-ALONE-P is +non-nil, then no faith-correction is done before insertion of the quote.. +" + (interactive) + (let* ((init-quote + (faith-false-choose + (if quotes quotes + (append faith-false-quotes faith-user-quotes)))) + (final-quote + (if leave-alone-p + init-quote + (faith-correct-string init-quote))) + (justified-quote (faith-justify-string final-quote))) + (if (interactive-p) + (message justified-quote) + justified-quote))) + +;;;###autoload +(defun faith-correct-buffer () + "Replace false Gods by the ONE TRUE GOD. +Takes a false SNIPPET, and weeds out the names of all false Gods and +prophets." + (interactive) + ;; Now, for each from in each from-list, select a random to from to-list. + ;; to-list is called tos and from-list is called froms. + (let ((case-replace t) + (case-fold-search t)) + (mapcar + (lambda (froms-tos) + (let ((tos (cadr froms-tos))) + (mapcar + (lambda (from) + (let ((this-to (nth (random* (length tos)) tos))) + (goto-char (point-min)) + (while (re-search-forward (concat "\\b" from "") + nil t) + (replace-match this-to nil nil)))) + (car froms-tos)))) + (append faith-user-before-replacement-strings + faith-replacement-strings + faith-user-after-replacement-strings)) + (buffer-substring (point-min) (point-max)))) + +;;;###autoload +(defun faith-correct-region (b e) + "Replace false Gods by the ONE TRUE GOD in region delimited by B and E." + (interactive "r") + (save-restriction + (save-excursion + (narrow-to-region b e) + (faith-correct-buffer) + (widen)))) + +;;;###autoload +(defun faith-correct-string (snippet) + "Replace false Gods by the ONE TRUE GOD. +Takes a false SNIPPET, and weeds out the names of all false Gods and +prophets." + (interactive) + (with-temp-buffer + (insert snippet) + (faith-correct-buffer) + (buffer-substring (point-min) (point-max)))) + +(defun faith-false-choose (quotes) + "Return a randomly chosen WRONG snippet. THUS NOT FOR HUMAN EYES. +Returns a randomly chosen false quote. Advice: Stay away. +Argument QUOTES is a list of quotes." + (let* ((n (random* (length quotes))) + (s (nth n quotes))) + (if (stringp s) s + (error (format "The quote at postition %d is no string." n s))))) + +(defun faith-justify-string (string) + "Justifies it.." + (with-temp-buffer + (insert string) + (fill-paragraph 1) + (buffer-substring (point-min) (point-max))) +) + +(unless faith-replacement-strings + (setq faith-replacement-strings + '( + (("allah" "buddha" "lord" "islam" "christianity" "hinduism") ("EMACS")) + (("almighty" "god") ("True Editor")) + (("adam" ) ("newbie")) + (("angel" ) ("truly free freebies")) + (("apostle") ( "book")) + (("bible" "koran") ("Emacs-manual")) + (("book") ("documentation")) + (("christ" ) ("emacs-homepage")) + (("christian" ) ("true follower")) + (("die" ) ("quit editland")) + (("gods") ("editors")) + (("earth" ) ("editland")) + (("heavens" ) ("elispland")) + (("holy spirit" ) ("holy editor")) + (("jesus" "muhammad" "muhammed" "mohammad" "mohammed") + ("gnu.org" "xemacs.org")) + (("mary") ("Gnus")) + (("Moses") ("Stallman" "RMS")) + (("the calf") ("vi")) + (("prophet") ("manual")) + (("religion") ("editing")) + (("satan") ("Microsoft" "Windoze" "VI")) + (("pray" ) ("edit")) + (("synagogue" "church") ("computer-room")) + ))) + + +(unless faith-false-quotes + (setq + faith-false-quotes + '("There shall be no compulsion in religion." + + "This Book is not to be doubted. . . . As for the unbelievers, it is +the same whether or not you forewarn them; they will not have faith. +God has set a seal upon their hearts and ears; their sight is dimmed +and grievous punishment awaits them." + + "The only true faith in God's sight is EMACS." + + "He that chooses a religion over Islam, it will not be accepted from +him and in the world to come he will be one of the lost." + + "It is not for true believers men or women to take their choice in the +affairs if God and His apostle decree otherwise. He that disobeys God +and His apostle strays far indeed." + + "God's curse be upon the infidels! Evil is that for which they have +bartered away their souls. To deny God's own revelation, grudging that +He should reveal His bounty to whom He chooses from among His +servants! They have incurred God's most inexorable wrath. An +ignominious punishment awaits the unbelievers." + + "Fight for the sake of God those that fight against you, but do not +attack them first. God does not love the aggressors. + +Slay them wherever you find them. Drive them out of the places from +which they drove you. Idolatry is worse than carnage." + + "Prophet, make war on the unbelievers and the hypocrites and deal +rigorously with them. Hell shall be their home: an evil fate." + + "The Lord is my strength and song; he has become my salvation. He is my +God, and I will praise him, my father's God, and I will exalt him." + + "Love the Lord your God with all your heart and with all your soul and +with all your strength." + + "Therefore go and make disciples of all nations, baptizing them in the +name of the Father and of the Son and the Holy Spirit, and teaching +them to obey everything I have commanded you. And surely I will be +with you always, to the very end of the age." + + "Have faith in God, Jesus answered. Therefore I tell you, whatever you +ask for in prayer, believe that you will receive it, and it will be +yours." + + "And Mary said: My soul praises the Lord and my spirit rejoices in God +my Saviour, for he has been mindful of the humble state of his +servant." + + "Jesus answered, It is written: Worship the Lord your God and serve him +only." + + "When you are brought before synagogues, rulers and authorities, do not +worry about how you will defend yourselves or what you will say, for +the Holy Spirit will teach you at that time what you should say." + + "Then Jesus cried out, When a man believes in me, he does not believe +in me only, but in the one who sent me. I have come into the world as +light, so that no one who believes in me should stay in darkness." + + "Jesus said, I am the way and the truth and the life. No one comes to +the Father except through me." + + "...Count yourselves dead to sin but alive to God in Christ Jesus." + + "May the God who gives endurance and encouragement give you a spirit of +unity among yourselves as you follow Christ Jesus ,so that with one +heart and mouth you may glorify the God and Father of our Lord Jesus +Christ." + + "May the God of hope fill you with great joy and peace as you trust in +him, so that you may overflow with hope by the power of the Holy +Spirit." + + "...God's abundant provision of grace and of the gift of righteousness +reign in life through the one and only , Jesus Christ." + + "The mind of sinful man is death, but the mind controlled by the Spirit +is life and peace, because the sinful mind is hostile to God. It does +not submit to God's law, nor can it do so. Those controlled by their +sinful nature cannot please God." + + "...No eyes have seen, no ear has heard, no mind had conceived what God +had prepared for those who love him but God had revealed it to us by his +Spirit. The spirit searches all things, even the deep things of God. For who +among men knows the thoughts of a man except the man's spirit within him? In +the same way no one knows the thoughts of God except the Spirit of God." + + "The Lord will rescue me from every evil attack and will bring me +safely to his heavenly kingdom." + + "For God did not give us a spirit of timidity, but a spirit of power, +of love and of self-discipline." + + "If you suffer as a Christian, do not be ashamed but praise God that +you bear that name." + + "Cast all your anxiety on Jesus because he cares for you." + + "57:1 All that is in heaven and earth gives glory to Allah. He is +the Mighty, the Wise One." + + "His is the kingdom of the heavens and the earth. He ordains life +and death and has power over all things." + + "He created the heavens and the earth in six days and then mounted +His throne. He knows all that goes into the earth and all that +emerges from it, all that comes down from heaven and all that +ascends to it. He is with you wherever you are. He is cognizant of +all your actions." + + "His is the kingdom of the heavens and the earth. To Him shall all +things return. He causes the night to pass into the day and the day +into the night. He has knowledge of the inmost thoughts of men." + + "24:34 Allah is the light of the heavens and the earth. His light +may be compared to a niche that enshrines a lamp, the lamp within a +crystal of star-like brilliance. It is lit from a blessed olive +tree neither eastern nor western. Its very oil would almost shine +forth, though no fire touched it. Light upon light; Allah guides to +His light whom He will." + + "24:36 As for the unbelievers, their works are like a mirage in a +desert. The thirsty traveler thinks it is water, but when he comes +near he finds that it is nothing. He finds Allah there, who pays +him back in full. Swift is Allah's reckoning." + + "Or like darkness on a bottomless ocean spread with clashing billows +and overcast with clouds: darkness upon darkness. If he stretches +out his hand he can scarcely see it. Indeed the man from whom Allah +withholds His light shall find no light at all." + + "10:80 We are the witnesses of all your thoughts and all your +prayers and all your actions. Not an atom's weight in earth or +heaven escapes your Lord, nor is there any object smaller or +greater, but is recorded in a glorious book." + + "58:7 Are you not aware that Allah knows what the heavens and the +earth contain? If three men talk in secret together, He is their +fourth; if four, He is their fifth; if five, He is their sixth; +whether fewer or more, wherever they be, He is with them. Then, on +the Day of Resurrection, He will inform them of their doings. Allah +has knowledge of all things." + + "39:39 Allah takes away men's souls upon their death, and the souls +of the living during their sleep. Those that are doomed He keeps +with Him and restores the others for a time ordained. Surely there +are signs in this for thinking men." + + "35:11 Praise be to Allah, the Creator of heaven and earth! He sends +forth the angels as His messengers, with two, three or four airs of +wings. He Multiplies His creatures according to His will. Allah has +power over all things." + + "2:32 To Adam We said: \"Dwell with your wife in Paradise and eat of +its fruits to your hearts' content wherever you will. But never +approach this tree or you shall both become transgressors.\" + +But Satan made them fall from Paradise and brought about their +banishment. \"Go hence,\" We said, \"and may your offspring be enemies +to each other. The earth will for a while provide your sustenance +and dwelling place.\" + +Then Adam received commandments from his Lord, and his Lord +relented towards him. He is the Forgiving One, the Merciful." + + "65:12 It is Allah who has created seven heavens, and earths as +many. His commandment descends through them, so that you may know +that Allah has power over all things, and that He has knowledge of +all things." + + "14:19 Do you not see that Allah has created the heavens and the +earth with truth? He can destroy you if He wills and bring into +being a new creation: that is no difficult thing for him." + + "40:67 It was He who created you from dust, making you a little +germ, and then a clot of blood. He brings you infants into the +world; you reach manhood, then decline into old age (though some of +you die young), so that you may complete your appointed term and +grow in wisdom." + + "16:75 To Allah belong the secrets of the heavens and the earth. The +business of the Final Hour shall be accomplished in the twinkling +of an eye, or even less. Allah has power over all things." + + "2:86 To Moses We gave the Scriptures and after him we sent other +apostles. We gave Jesus the son of Mary veritable signs and +strengthened him with the Holy Spirit. Will you then scorn each +apostle whose message does not suit your fancies, charging some +with imposture and slaying others?" + + "6:104 They solemnly swear by Allah that if a sign be given them +they would believe in it. Say: \"Signs are vouchsafed by Allah.\" And +how can you tell that if a sign be given them they will indeed +believe in it?" + + "We will turn away their hearts and eyes from the truth since they +refused to believe in it at first. We will leave them to blunder +about in their wrongdoing." + + "If We sent down the angels and caused the dead to speak with them, +and ranged all things before them, they would still not believe, +Unless Allah willed it. But most of them are ignorant men." + + "4:153 The People of the Book ask you to bring down for them a book +from heaven. Of Moses they demanded a harder thing than that. They +said to him: \"Show us Allah distinctly.\" And for their wickedness a +thunderbolt smote them. They worshipped the calf after We revealed +to them Our signs; yet We forgave them that, and bestowed on Moses +clear authority." + + "32:21 We gave the Scriptures to Moses (never doubt that you will +meet him) and made it a guide for Israelites. And when they grew +steadfast and firmly believed in Our revelations, We appointed +leaders from among them who gave guidance at Our bidding. On the +Day of Resurrection your Lord will resolve for them their +differences." + + "4:171 People of the Book, do not transgress the bounds of your +religion. Speak nothing but the truth about Allah. The Messiah, +Jesus the son of Mary, was no more than Allah's apostle and His +Word which he cast to Mary: a spirit from Him. So believe in Allah +and His apostles and do not say: \"Three;\" Forbear, and it shall be +better for you. Allah is but one God. Allah forbid that He should +have a son! His is all that the heavens and the earth contain. +Allah is the all-sufficient Protector. The Messiah does not disdain +to be a servant of Allah, nor do the angels who are nearer to him. +Those who through arrogance disdain His service shall all be +brought before Him." + + "73:1 You that are wrapped up in your mantle, keep vigil all night, +save for a few hours; half the night, or even less: or a little +more - and with measured tone recite the Koran, for We are about to +address to you words of surpassing gravity. It is in the watches of +the night that impressions are strongest and words most eloquent; +in the day-time you are hard-pressed with work. + +\(You need not move your tongue too fast to learn this revelation. +We Ourself shall see to its collection and recital. When We read +it, follow its words attentively; We shall Ourself explain its +meaning.)" + + "20:114 Do not be quick to recite the Koran before its revelation is +completed, but rather say: \"Lord, increase my knowledge.\"" + + "42:48 Thus We have inspired you with a spirit of Our will when you +knew nothing of faith or scripture, and made it a light whereby we +guide those of Our servants whom We please. You shall surely guide +them to the right path: the path of Allah, to whom belongs all that +the heavens and the earth contain. All things in the end return to +him." + + "25:27 The unbelievers ask: \"Why was the Koran not revealed to him +entire in a single revelation?\" + +We have revealed it thus so that We may strengthen your faith. We +have imparted it to you by gradual revelation. No sooner will they +come to you with an argument than We shall reveal to you the truth +and properly explain it. Those who will be dragged headlong into +Hell shall have an evil place to-dwell in, for they have strayed +far from the right path." + + "4:159 We have revealed Our will to you as We revealed it to Noah +and to the prophets who came after him; as We revealed it to +Abraham, Ishmael, Isaac, Jacob, and David, to whom We gave the +Psalms. Of some apostles We have already told you (how Allah spoke +directly to Moses); but there are others of whom We have not yet +spoken: apostles who brought good news to mankind and admonished +them, so that they might have no plea against Allah after their +coming. Allah is mighty and wise." + + "40:78 We have sent forth other apostles before you, of some you +have already heard, of others We have told you nothing. Yet none of +these could work a miracle except by Allah's leave. And when +Allah's will is done, justice will prevail and those who have +denied His signs will come to grief." + + "16:40 The apostles We sent before you were no more than mortals +whom We inspired with revelations and with writings. Ask the People +of the Book, ii you doubt this. To you We have revealed the Koran, +so that you may proclaim to men what has been revealed to them, and +that they may give thought." + + "13:38 We have sent forth other apostles before you and given them +wives and children. Yet none of them could work miracles except by +the will of Allah. Every age has its scripture. Allah confirms or +abrogates what He pleases. His is the Eternal Book." + + "22:46 Never have We sent a single prophet or apostle before you +with whose wishes Satan did not tamper. But Allah abrogates the +interjections of Satan and confirms His own revelations. Allah is +wise and all-knowing. He makes Satan's interjections a temptation +for those whose hearts are diseased or hardened - this is why the +wrongdoers are in open schism - so that those to whom knowledge has +been given may realize that this is the truth from your Lord and +thus believe in it and humble their hearts towards him. Allah will +surely guide the faithful to a straight path." + + "36:68 We have taught Mohammed no poetry, nor does it become him to +be a poet. This is but a warning: an eloquent Koran to admonish the +living and No pass judgment on the unbelievers." + + "29:48 Never have you read a book before this, nor have you ever +transcribed one with your right hand. Had you done either of these, +- the unbelievers might have justly doubted. But to those who are +endowed with knowledge it is an undoubted sign. Only the wrongdoers +deny Our signs." + + "68:1 By the pen, and what they write, you are not mad: thanks to +the favor of your Lord! A lasting recompense awaits you, for yours +is a sublime nature. You shall before long see - as they will see - +which of you is mad." + + "39:22 Allah has now revealed the best of scriptures, a book uniform +in style proclaiming promises and warnings. Those who fear their +Lord are filled with awe as they listen to its revelations, so that +their hearts soften at the remembrance of Allah. Such is Allah's +guidance: He bestows it on whom He will. But he whom Allah misleads +shall have none to guide him." + + "Allah is the only GOD and Muhammad is HIS only prophet." + ))) + + + + +(provide 'faith) +;;; faith.el ends here diff --git a/elisp/erbot/contrib/flame.el b/elisp/erbot/contrib/flame.el new file mode 100644 index 0000000..f878891 --- /dev/null +++ b/elisp/erbot/contrib/flame.el @@ -0,0 +1,356 @@ +;;; flame.el --- automatic generation of flamage, as if we needed more + +;;; Author: Ian G. Batten <batten@uk.ac.bham.multics> +;;; Maintainer: Noah Friedman <friedman@splode.com> +;;; Keywords: games + +;;; $Id: flame.el,v 1.1 2004/12/16 01:44:34 mwolson Exp $ + +;;; Commentary: + +;;; "Flame" program. This has a chequered past. +;;; +;;; The original was on a Motorola 286 running Vanilla V.1, +;;; about 2 years ago. It was couched in terms of a yacc (I think) +;;; script. I pulled the data out of it and rewrote it as a piece +;;; of PL/1 on Multics. Now I've moved it into an emacs-lisp +;;; form. If the original author cares to contact me, I'd +;;; be very happy to credit you! +;;; +;;; Ian G. Batten, Batten@uk.ac.bham.multics + +;;; On 1994/01/09, I discovered that rms dropped this file from the Emacs +;;; 19 distribution sometime before 19.7 was released. He made no +;;; ChangeLog entry and didn't keep the source file around (by convention, +;;; we usually renamed files we wanted to keep but not go into official +;;; distributions so that they started with `=', e.g. `=flame.el'). This +;;; is all he had to say about it when I asked: +;;; +;;; I think I decided I was unhappy with the legal papers for it. +;;; Removing it took less time than trying to deal with it +;;; any other way. +;;; +;;; I eventually found it on a backup tape, and I am now independently +;;; maintaining it. +;;; +;;; --Noah + +;;; Code: + +(random t) + +(defvar flame-sentence + '((how can you say that (flame-statement) \?) + (I can\'t believe how (flame-adjective) you are\.) + (only a (flame-der-term) like you would say that (flame-statement) \.) + ((flame-statement) \, huh\?) (so\, (flame-statement) \?) + ((flame-statement) \, right\?) (I mean\, (flame-sentence)) + (don\'t you realise that (flame-statement) \?) + (I firmly believe that (flame-statement) \.) + (let me tell you something\, you (flame-der-term) \, (flame-statement) \.) + (furthermore\, you (flame-der-term) \, (flame-statement) \.) + (I couldn\'t care less about your (flame-thing) \.) + (How can you be so (flame-adjective) \?) + (you make me sick\.) + (it\'s well known that (flame-statement) \.) + ((flame-statement) \.) + (it takes a (flame-group-adj) (flame-der-term) like you to say that (flame-statement) \.) + (I don\'t want to hear about your (flame-thing) \.) + (you\'re always totally wrong\.) + (I\'ve never heard anything as ridiculous as the idea that (flame-statement) \.) + (you must be a real (flame-der-term) to think that (flame-statement) \.) + (you (flame-adjective) (flame-group-adj) (flame-der-term) \!) + (you\'re probably (flame-group-adj) yourself\.) + (you sound like a real (flame-der-term) \.) + (why\, (flame-statement) \!) + (I have many (flame-group-adj) friends\.) + (save the (flame-thing) s\!) (no nukes\!) (ban (flame-thing) s\!) + (I\'ll bet you think that (flame-thing) s are (flame-adjective) \.) + (you know\, (flame-statement) \.) + (your (flame-quality) reminds me of a (flame-thing) \.) + (you have the (flame-quality) of a (flame-der-term) \.) + ((flame-der-term) \!) + ((flame-adjective) (flame-group-adj) (flame-der-term) \!) + (you\'re a typical (flame-group-adj) person\, totally (flame-adjective) \.) + (man\, (flame-sentence)))) + +(defvar flame-sentence-loop (nconc flame-sentence flame-sentence)) + +(defvar flame-quality + '((ignorance) (stupidity) (worthlessness) + (prejudice) (lack of intelligence) (lousiness) + (bad grammar) (lousy spelling) + (lack of common decency) (ugliness) (nastiness) + (subtlety) (dishonesty) ((flame-adjective) (flame-quality)))) + +(defvar flame-quality-loop (nconc flame-quality flame-quality)) + +(defvar flame-adjective + '((ignorant) (crass) (pathetic) (sick) + (bloated) (malignant) (perverted) (sadistic) + (stupid) (unpleasant) (lousy) (abusive) (bad) + (braindamaged) (selfish) (improper) (nasty) + (disgusting) (foul) (intolerable) (primitive) + (depressing) (dumb) (phoney) (boring) + (gratuitous) ((flame-adjective) and (flame-adjective)) + (as (flame-adjective) as a (flame-thing)))) + +(defvar flame-adjective-loop (nconc flame-adjective flame-adjective)) + +(defvar flame-der-term + '(((flame-adjective) (flame-der-term)) (sexist) (fascist) + (weakling) (coward) (beast) (peasant) (racist) + (cretin) (fool) (jerk) (ignoramus) (idiot) + (wanker) (rat) (slimebag) (DAF driver) (quiche-eater) + (Neanderthal) (sadist) (drunk) (capitalist) + (wimp) (dogmatist) (wally) (maniac) (luser) + (whimpering scumbag) (pea brain) (arsehole) + (moron) (goof) (incompetent) (lunkhead) (Nazi) + (SysThug) ((flame-der-term) (flame-der-term)))) + +(defvar flame-der-term-loop (nconc flame-der-term flame-der-term)) + +(defvar flame-thing + '(((flame-adjective) (flame-thing)) (computer) + (Honeywell dps8) (whale) (operation) + (sexist joke) (ten-incher) (dog) (MicroVAX II) + (source license) (real-time clock) + (mental problem) (sexual fantasy) + (venereal disease) (Jewish grandmother) + (cardboard cut-out) (punk haircut) (surfboard) + (system call) (wood-burning stove) + (standard text editor) (processed lunch meat) + (graphics editor) (right wing death squad) + (disease) (vegetable) (religion) (random frob) + (cruise missile) (bug fix) (lawyer) (copyright) + (PAD))) + +(defvar flame-thing-loop (nconc flame-thing flame-thing)) + + +(defvar flame-group-adj + '((gay) (old) (lesbian) (young) (black) + (Polish) ((flame-adjective)) (white) + (mentally retarded) (Nicaraguan) (homosexual) + (dead) (underpriviledged) (religious) + ((flame-thing) \-loving) (feminist) (foreign) + (intellectual) (crazy) (working) (unborn) + (Chinese) (short) ((flame-adjective)) (poor) (rich) + (funny-looking) (Puerto Rican) (Mexican) + (Italian) (communist) (fascist) (Iranian) + (Moonie))) + +(defvar flame-group-adj-loop (nconc flame-group-adj flame-group-adj)) + +(defvar flame-statement + '((your (flame-thing) is great) ((flame-thing) s are fun) + ((flame-person) is a (flame-der-term)) + ((flame-group-adj) people are (flame-adjective)) + (every (flame-group-adj) person is a (flame-der-term)) + (most (flame-group-adj) people have (flame-thing) s) + (all (flame-group-adj) dudes should get (flame-thing) s) + ((flame-person) is (flame-group-adj)) (trees are (flame-adjective)) + (if you\'ve seen one (flame-thing) \, you\'ve seen them all) + (you\'re (flame-group-adj)) (you have a (flame-thing)) + (my (flame-thing) is pretty good) + (the Martians are coming) + (the (flame-paper) is always right) + (just because you read it in the (flame-paper) that doesn\'t mean it\'s true) + ((flame-person) was (flame-group-adj)) + ((flame-person) \'s ghost is living in your (flame-thing)) + (you look like a (flame-thing)) + (the oceans are full of dirty fish) + (people are dying every day) + (a (flame-group-adj) man ain\'t got nothing in the world these days) + (women are inherently superior to men) + (the system staff is fascist) + (there is life after death) + (the world is full of (flame-der-term) s) + (you remind me of (flame-person)) (technology is evil) + ((flame-person) killed (flame-person)) + (the Russians are tapping your phone) + (the Earth is flat) + (it\'s OK to run down (flame-group-adj) people) + (Multics is a really (flame-adjective) operating system) + (the CIA killed (flame-person)) + (the sexual revolution is over) + (Lassie was (flame-group-adj)) + (the (flame-group-adj) people have really got it all together) + (I was (flame-person) in a previous life) + (breathing causes cancer) + (it\'s fun to be really (flame-adjective)) + ((flame-quality) is pretty fun) (you\'re a (flame-der-term)) + (the (flame-group-adj) culture is fascinating) + (when ya gotta go ya gotta go) + ((flame-person) is (flame-adjective)) + ((flame-person) \'s (flame-quality) is (flame-adjective)) + (it\'s a wonderful day) + (everything is really a (flame-thing)) + (there\'s a (flame-thing) in (flame-person) \'s brain) + ((flame-person) is a cool dude) + ((flame-person) is just a figment of your imagination) + (the more (flame-thing) s you have, the better) + (life is a (flame-thing)) (life is (flame-quality)) + ((flame-person) is (flame-adjective)) + ((flame-group-adj) people are all (flame-adjective) (flame-der-term) s) + ((flame-statement) \, and (flame-statement)) + ((flame-statement) \, but (flame-statement)) + (I wish I had a (flame-thing)) + (you should have a (flame-thing)) + (you hope that (flame-statement)) + ((flame-person) is secretly (flame-group-adj)) + (you wish you were (flame-group-adj)) + (you wish you were a (flame-thing)) + (I wish I were a (flame-thing)) + (you think that (flame-statement)) + ((flame-statement) \, because (flame-statement)) + ((flame-group-adj) people don\'t get married to (flame-group-adj) people because (flame-reason)) + ((flame-group-adj) people are all (flame-adjective) because (flame-reason)) + ((flame-group-adj) people are (flame-adjective) \, and (flame-reason)) + (you must be a (flame-adjective) (flame-der-term) to think that (flame-person) said (flame-statement)) + ((flame-group-adj) people are inherently superior to (flame-group-adj) people) + (God is Dead))) + +(defvar flame-statement-loop (nconc flame-statement flame-statement)) + + +(defvar flame-paper + '((Daily Mail) (Daily Express) (Boston Glob) + (Centre Bulletin) (Sun) (Daily Mirror) (Pravda) + (Daily Telegraph) (Beano) (Multics Manual))) + +(defvar flame-paper-loop (nconc flame-paper flame-paper)) + + +(defvar flame-person + '((Reagan) (Ken Thompson) (Dennis Ritchie) + (JFK) (the Pope) (Gadaffi) (Napoleon) + (Karl Marx) (Groucho) (Michael Jackson) + (Caesar) (Nietzsche) (Heidegger) (\"Head-for-the-mountains\" Bush) + (Henry Kissinger) (Nixon) (Castro) (Thatcher) + (Attilla the Hun) (Alaric the Visigoth) (Hitler))) + +(defvar flame-person-loop (nconc flame-person flame-person)) + +(defvar flame-reason + '((they don\'t want their children to grow up to be too lazy to steal) + (they can\'t tell them apart from (flame-group-adj) dudes) + (they\'re too (flame-adjective)) + ((flame-person) wouldn\'t have done it) + (they can\'t spray paint that small) + (they don\'t have (flame-thing) s) (they don\'t know how) + (they can\'t afford (flame-thing) s))) + +(defvar flame-reason-loop (nconc flame-reason flame-reason)) + + +(defmacro flame-define-element (name) + (let ((loop-to-use (intern (concat name "-loop")))) + (` (defun (, (intern name)) nil + (let ((step-forward (% (random) 10))) + (if (< step-forward 0) (setq step-forward (- step-forward))) + (prog1 + (nth step-forward (, loop-to-use)) + (setq (, loop-to-use) (nthcdr (1+ step-forward) (, loop-to-use))))))))) + +(flame-define-element "flame-sentence") +(flame-define-element "flame-quality") +(flame-define-element "flame-adjective") +(flame-define-element "flame-der-term") +(flame-define-element "flame-group-adj") +(flame-define-element "flame-statement") +(flame-define-element "flame-thing") +(flame-define-element "flame-paper") +(flame-define-element "flame-person") +(flame-define-element "flame-reason") + +(defun *flame nil + (flame-expand '(flame-sentence))) + +(defun flame-expand (object) + (cond ((atom object) + object) + (t (mapcar 'flame-expand (funcall (car object)))))) + +(defun flame-flatten (list) + (cond ((atom list) + (list list)) + ((null list)) + (t (apply 'append (mapcar 'flame-flatten list))))) + +;;;###autoload +(defun flame (&optional arg) + "Generate ARG (default 1) sentences of half-crazed gibberish. +If interactive, print the result in a buffer and display it. +Otherwise, just return the result as a string." + (interactive "p") + (or arg (setq arg 1)) + (if (interactive-p) + (let ((w (selected-window))) + (pop-to-buffer (get-buffer-create "*Flame*")) + (goto-char (point-max)) + (insert ?\n) + (flame2 arg) + (select-window w)) + (let (result) + (while (> arg 0) + (setq result (concat result + (flame-string) + (if (= 1 arg) "" "\n"))) + (setq arg (1- arg))) + result))) + +(defun flame2 (arg) + (let ((start (point))) + (flame1 arg) + (fill-region-as-paragraph start (point) t))) + +(defun flame1 (arg) + (cond ((zerop arg) t) + (t (insert (flame-string)) + (flame1 (1- arg))))) + +(defun flame-string () + (concat (flame-sentence-ify + (flame-string-ify + (flame-append-suffixes-hack + (flame-flatten (*flame))))))) + +(defun flame-sentence-ify (string) + (concat (upcase (substring string 0 1)) + (substring string 1 (length string)) + " ")) + +(defun flame-string-ify (list) + (mapconcat + '(lambda (x) + (format "%s" x)) + list + " ")) + +(defun flame-append-suffixes-hack (list) + (cond ((null list) + nil) + ((memq (nth 1 list) + '(\? \. \, s\! \! s \'s \-loving)) + (cons (intern (format "%s%s" (nth 0 list) (nth 1 list))) + (flame-append-suffixes-hack (nthcdr 2 list)))) + (t (cons (nth 0 list) + (flame-append-suffixes-hack (nthcdr 1 list)))))) + +(defun psychoanalyze-flamer () + "Mr. Angry goes to the analyst." + (interactive) + (doctor) ; start the psychotherapy + (message "") + (switch-to-buffer "*doctor*") + (sit-for 0) + (while (not (input-pending-p)) + (flame2 (if (= (% (random) 2) 0) 2 1)) + (insert "\n") + (sit-for 0) + (doctor-ret-or-read 1))) + +(provide 'flame) + +;;; flame.el ends here diff --git a/elisp/erbot/contrib/geek.el b/elisp/erbot/contrib/geek.el new file mode 100644 index 0000000..6563884 --- /dev/null +++ b/elisp/erbot/contrib/geek.el @@ -0,0 +1,138 @@ +;;; geek.el --- annoy lusers who think the geek code is wAY ko0l RADIKuL D00D!1 + +;; Copyright (C) 1995 American Telephone & Telegraph, Inc. + +;; Author: Noah Friedman <friedman@prep.ai.mit.edu> +;; Maintainer: friedman@prep.ai.mit.edu +;; Created: 1995-01-07 + +;; $Id: geek.el,v 1.1 2004/12/16 01:44:34 mwolson Exp $ + +;; This software is is guaranteed to do nothing useful, except when it +;; does. You may sell it, burn it, use it, modify it, or give it away, at +;; your leisure. You may even require that other people use it. You may +;; also require that people not use it, as you see fit. Government +;; agencies are encouraged to integrate this software into weapons control +;; systems and other instruments of destruction. + +;;; Commentary: +;;; Code: + +(defvar geek-header "X-Geek-Code") + +(defvar geek-suffix-single-chars ["?" "@" "$" "!" "*"]) +(defvar geek-suffix-long-chars [?+ ?- ?+ ?- ?+ ?- ?+ ?- ?+ ?- ?+ ?- ?']) +(defvar geek-infix-chars [">" ":"]) + +(defvar geek-letters + ["A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" + "S" "T" "U" "V" "W" "X" "Y" "Z" + "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" + "s" "t" "u" "v" "w" "x" "y" "z" + "0" "1" "2" "3" "4" "5" "6" "7" "8" "9"]) + +(if (string-lessp emacs-version "19") + (defun geek-random (&optional n) + (if (numberp n) + (abs (% (random) n)) + (random n))) + (defalias 'geek-random 'random)) + +(defun geek-item (v) + (aref v (geek-random (length v)))) + +(defun geek-code () + (let ((ncodes (+ 10 (geek-random 40))) + (codes "") + (nflavors (+ 4 (geek-random 8))) + (flavors "") + letter + len len1 + char char1 + tem + i + (vmajor (int-to-string (1+ (geek-random 8)))) + (vminor (int-to-string (geek-random 100)))) + (setq i nflavors) + (while (not (zerop i)) + (setq flavors (concat flavors "/")) + (setq len (1+ (geek-random 2))) + (while (not (zerop len)) + (setq tem (geek-item geek-letters)) + (setq flavors (concat flavors tem)) + (setq len (1- len))) + (setq i (1- i))) + (aset flavors 0 ?G) + + (setq i ncodes) + (while (not (zerop i)) + (setq letter (geek-item geek-letters)) + (and (zerop (geek-random 10)) + (setq letter (concat letter (geek-item geek-letters)))) + + (setq len (geek-random 5)) + (setq char (geek-item geek-suffix-long-chars)) + (setq letter (concat letter (make-string len char))) + + (cond + ((zerop len)) + ((= char ?')) + ((zerop (geek-random 5)) + (setq char1 (geek-item geek-infix-chars)) + (setq letter (concat letter char1)) + + (setq len1 (1+ (geek-random 4))) + (setq char1 char) + (while (= char char1) + (setq char1 (geek-item geek-suffix-long-chars))) + (setq letter (concat letter (make-string len1 char1))))) + + (cond + ((zerop len) + (and (zerop (geek-random 3)) + (setq letter (concat letter + (geek-item geek-suffix-single-chars))))) + ((zerop (geek-random 5)) + (setq len1 (1+ (geek-random 2))) + (setq letter (concat letter "(" (make-string len1 ?*) ")")))) + + (setq codes (concat codes " " letter)) + (setq i (1- i))) + (setq codes (concat "(V" vmajor "." vminor ") " + flavors codes)) + codes)) + +(defun geek-replace-header (s) + (save-excursion + (cond + ((mail-position-on-field geek-header 'soft) + (let* ((data (match-data)) + (end (point)) + (beg (progn + (re-search-backward (concat geek-header ": ")) + (match-end 0))) + (orig (buffer-substring beg end)) + ;; avoid creating any permanent undo boundaries + (buffer-undo-list nil)) + (store-match-data (match-data)) + (delete-region beg end) + (goto-char beg) + (insert s) + orig))))) + +(defun geek-subvert-header () + (let ((s (geek-replace-header (geek-code)))) + (add-hook 'mail-send-actions (list 'geek-restore-header s) 'append))) + +(defun geek-restore-header (s) + (and s (geek-replace-header s))) + +;; mib is an extra special twit. +(cond + ((and (string= (user-login-name) "mib") + (fboundp 'add-hook)) + (add-hook 'mail-send-hook 'geek-subvert-header 'append))) + +(provide 'geek) + +;;; geek.el ends here. diff --git a/elisp/erbot/contrib/google.el b/elisp/erbot/contrib/google.el new file mode 100644 index 0000000..d940119 --- /dev/null +++ b/elisp/erbot/contrib/google.el @@ -0,0 +1,271 @@ +;;; Debugging info for self: Saved through ges-version 1.5dev +;;; ;;; From: Edward O'Connor <ted@oconnor.cx> +;;; ;;; Subject: google.el +;;; ;;; Newsgroups: gnu.emacs.sources +;;; ;;; Date: Sat, 14 Sep 2002 10:37:56 GMT +;;; ;;; Organization: RoadRunner - West + +;;; > google.el --- Emacs interface to the Google API + +;;; Virtually unchanged; just fixed a remarkably embarassing bug. + +;;; + +;;; google.el --- Emacs interface to the Google API + +;; Copyright (C) 2002 Edward O'Connor <ted@oconnor.cx> + +;; Author: Edward O'Connor <ted@oconnor.cx> +;; Keywords: comm, processes, tools +;; Version: 0.1 + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; A really bare-bones first hack at Google API support for Emacs. +;; Note that you need a Google license key to use this; you can +;; get one by following the instructions here: + +;; <URL:http://www.google.com/apis/> + +;; Usage: + +;; (require 'google) +;; (setq google-license-key "my license key") +;; Then M-x google-search RET +;; or M-x google-search-region RET + +;; To use this in a program, see the functions `google-search' and +;; `google-display-response' for example usage. + +;;; Code: + +(require 'soap) +(require 'xml) + +(defgroup google nil + "" + :group 'tools) + +(defcustom google-license-key nil + "*Your Google license key." + :type '(string) + :group 'google) + +(defcustom google-search-result-callback nil + "*The function to be called with the search result." + :type '(function) + :group 'google) + +(defcustom google-start 0 + "*Which result to start with." + :type 'integer + :group 'google) + +(defcustom google-max-results 10 + "*Maximum number of results to return." + :type 'integer + :group 'google) + +(defcustom google-filter-p t + "*Whether or not to filter results." + :type 'boolean + :group 'google) + +(defcustom google-safe-p nil + "*Safe or not?" + :type 'boolean + :group 'google) + +(defcustom google-linkify-links-p t + "*Whether or not we should linkify links in the response buffer." + :type 'boolean + :group 'google) + +(defun google-xml-sexp-attr-to-xml (attr-cons) + (let ((attr-name (car attr-cons)) + (attr-val (cdr attr-cons))) + (unless (stringp attr-val) + (setq attr-val (format "%s" attr-val))) + (concat (format " %s=" attr-name) + (if (string-match "[\"]" attr-val) + (format "'%s'" attr-val) + (format "\"%s\"" attr-val))))) + +(defun google-xml-sexp-to-xml (xml-sexp) + "Return a string containing an XML representation of XML-SEXP." + (cond ((null xml-sexp) + "") + ((stringp xml-sexp) + xml-sexp) + ((listp xml-sexp) + (let ((tag (xml-node-name xml-sexp)) + (attrs (xml-node-attributes xml-sexp)) + (children (xml-node-children xml-sexp))) + (concat (format "<%s" tag) + (if attrs + (mapconcat 'google-xml-sexp-attr-to-xml + attrs + "") + "") + (if children + (concat ">" + (mapconcat 'google-xml-sexp-to-xml + children + "") + (format "</%s>" tag)) + "/>")))) + + (t (google-xml-sexp-to-xml (format "%s" xml-sexp))))) + +(defun google-request (xml-sexp) + "Send XML-SEXP to Google as a request." + (soap-request "http://api.google.com/search/beta2" + (google-xml-sexp-to-xml xml-sexp))) + +(defun google-search-internal (terms start max-results filter-p safe-p) + "Search for TERMS." + (google-request + `(SOAP-ENV:Envelope ((xmlns:SOAP-ENV + . "http://schemas.xmlsoap.org/soap/envelope/") + (xmlns:xsi + . "http://www.w3.org/1999/XMLSchema-instance") + (xmlns:xsd . "http://www.w3.org/1999/XMLSchema")) + (SOAP-ENV:Body () + (ns1:doGoogleSearch ((xmlns:ns1 . "urn:GoogleSearch") + (SOAP-ENV:encodingStyle . + "http://schemas.xmlsoap.org/soap/encoding/")) + (key ((xsi:type . "xsd:string")) + ,google-license-key) + (q ((xsi:type . "xsd:string")) + ,terms) + (start ((xsi:type . "xsd:int")) + ,(format "%d" start)) + (maxResults ((xsi:type . "xsd:int")) + ,(format "%d" max-results)) + (filter ((xsi:type . "xsd:boolean")) + ,(if filter-p "true" "false")) + (restrict ((xsi:type . "xsd:string"))) + (safeSearch ((xsi:type . "xsd:boolean")) + ,(if safe-p "true" "false")) + (lr ((xsi:type . "xsd:string"))) + (ie ((xsi:type . "xsd:string")) + "latin1") + (oe ((xsi:type . "xsd:string")) + "latin1")))))) + +(defvar google-result-mode-map (make-sparse-keymap) + "Map to be used in `google-result-mode'.") + +(define-key google-result-mode-map "q" 'google-result-quit) + +(defun google-result-quit () + (interactive) + (kill-buffer (get-buffer-create "*google-response*"))) + +(defun google-result-mode () + (kill-all-local-variables) + (setq major-mode 'google-result-mode + mode-name "Google Result") + (set (make-local-variable 'font-lock-defaults) + '(message-font-lock-keywords t)) + (use-local-map google-result-mode-map)) + +(defun google-display-response (processed-response) + (with-current-buffer (get-buffer-create "*google-response*") + (delete-region (point-min) + (point-max)) + (google-result-mode) + (insert (format "Google search results for %S\n" (car processed-response)) + "-------------------------------------------------\n\n") + (setq processed-response (cdr processed-response)) + (while processed-response + (let* ((item (car processed-response)) + (url (nth 0 item)) + (title (nth 1 item)) + (hostname (nth 2 item)) + (cached-size (nth 3 item)) + (snippet (nth 4 item))) + + (when title + (insert (format "Title: %s\n" title))) + + (when url + (insert (format "URL: %s\n" url))) + + (when hostname + (insert (format "Hostname: %s\n" hostname))) + + (when cached-size + (insert (format "Size: %s\n" cached-size))) + + (when snippet + (insert (format "Snippet: %s\n" snippet))) + + (insert "\n")) + + (setq processed-response (cdr processed-response))) + (when google-linkify-links-p + (goto-address)) + (switch-to-buffer (current-buffer)))) + +(defun google-process-response (response) + (let* ((body (car (xml-get-children (car response) 'SOAP-ENV:Body))) + (g-s-r (car (xml-get-children body 'ns1:doGoogleSearchResponse))) + (return (car (xml-get-children g-s-r 'return))) + (search-query (nth 2 (car (xml-get-children return 'searchQuery)))) + (r-e (car (xml-get-children return 'resultElements))) + (items (xml-get-children r-e 'item)) + (retval '())) + + (while items + (let* ((item (car items)) + (hostname (nth 2 (car (xml-get-children item 'hostName)))) + (url (nth 2 (car (xml-get-children item 'URL)))) + (title (nth 2 (car (xml-get-children item 'title)))) + (snippet (nth 2 (car (xml-get-children item 'snippet)))) + (cached-size (nth 2 (car (xml-get-children item 'cachedSize)))) + (retval-item '())) + + (add-to-list 'retval-item url t) + (add-to-list 'retval-item title t) + (add-to-list 'retval-item hostname t) + (add-to-list 'retval-item cached-size t) + (add-to-list 'retval-item snippet t) + + (add-to-list 'retval retval-item) + + (setq items (cdr items)))) + + (cons search-query retval))) + +(defun google-search (terms) + "Search for TERMS." + (interactive "sGoogle search: ") + (google-display-response + (google-process-response + (google-search-internal terms google-start google-max-results + google-filter-p google-safe-p)))) + +(defun google-search-region (beg end) + "Perform a Google search on the words from BEG to END." + (interactive "r") + (google-search (buffer-substring-no-properties beg end))) + +(provide 'google) +;;; google.el ends here + diff --git a/elisp/erbot/contrib/h4x0r.el b/elisp/erbot/contrib/h4x0r.el new file mode 100644 index 0000000..8b20858 --- /dev/null +++ b/elisp/erbot/contrib/h4x0r.el @@ -0,0 +1,106 @@ +; h4x0r.el 0.11 +; Time-stamp: <2003-02-22 00:47:54 deego> + +; by Charles Sebold <csebold@livingtorah.org> +; +; thanks to Alex Schroeder for typo fix and feature suggestions (which +; I have not begun to implement yet) + +;;; Copyright: (C) 2000, 2001 Charles Sebold +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 3 of +;; the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public +;; License along with GNU Emacs; if not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, +;; MA 02111-1307, USA. +;; +;; Latest version should be available at: +;; <URL:http://www.livingtorah.org/~csebold/emacs/h4x0r.el> +;; + + +(require 'cl) + +(defvar h4x0r-always-replace + '(("hacker" . "h4x0r") ("hack" . "h4x0r") ("elite" . "31337") + ("fear" . "ph33r"))) + +(defvar h4x0r-sometimes-replace + '(("ea" "33") ("er" "0r") ("a" "4") ("b" "8") ("d" "|>") + ("e" "3" "E") ("f" "|=") ("h" "|-|") ("i" "1" "|") ("k" "|<" "x") + ("l" "1" "|_") ("m" "|\\/|") ("n" "|\\|") ("o" "0") ("q" "@") ("s" + "5" "Z" "$") ("t" "+" "7") ("ck" "x") ("u" "U") ("v" "\\/") ("x" + "X" "><") ("y" "j"))) + +(defvar h4x0r-unreadable 5) + +(defvar h4x0r-replace-with-symbols-p nil) + +(defun h4x0r-region (beg end) + "Convert region to h4x0r-talk." + (interactive "r") + (save-excursion + (let ((starting-buffer (current-buffer))) + (set-buffer (get-buffer-create "h4x0r-temp")) + (insert-buffer-substring starting-buffer beg end) + (downcase-region (point-min) (point-max)) + (dotimes (i (length h4x0r-always-replace)) + (beginning-of-buffer) + (let ((old-word (car (nth i h4x0r-always-replace))) + (new-word (cdr (nth i h4x0r-always-replace)))) + (while (search-forward old-word nil t) + (replace-match new-word)))) + (dotimes (i (length h4x0r-sometimes-replace)) + (if (< (random 9) h4x0r-unreadable) + (progn + (beginning-of-buffer) + (let ((old-char (car (nth i h4x0r-sometimes-replace)))) + (let ((new-char (h4x0r-assoc old-char))) + (while (search-forward old-char nil t) + (replace-match new-char nil t))))))) + (set-buffer starting-buffer) + (delete-region beg end))) + (insert-buffer "h4x0r-temp") + (message "%s" "J00 h4v3 b33n h4x0r3d!") + (kill-buffer "h4x0r-temp")) + +(defun h4x0r-assoc (normal-char) + (let ((h4-out (cdr (assoc normal-char h4x0r-sometimes-replace)))) + (if (nlistp h4-out) + h4-out + (nth (random (length h4-out)) h4-out)))) + +(defun h4x0r-buffer () + "Convert entire buffer to h4x0r-talk." + (interactive) + (save-excursion + (h4x0r-region (point-max) (point-min)))) + +(defun h4x0r-word-at-point () + (interactive) + (save-excursion + (forward-word -1) + (insert (h4x0r-string (current-word))) + (kill-word 1))) + +(defun h4x0r-string (h4-input-string) + (save-excursion + (let ((starting-buffer (current-buffer))) + (set-buffer (get-buffer-create "h4x0r-string-temp")) + (insert h4-input-string) + (h4x0r-buffer) + (setq h4-input-string (buffer-string)) + (kill-buffer "h4x0r-string-temp") + (set-buffer starting-buffer))) + h4-input-string) + +(provide 'h4x0r) diff --git a/elisp/erbot/contrib/haiku.el b/elisp/erbot/contrib/haiku.el new file mode 100644 index 0000000..b66b6d7 --- /dev/null +++ b/elisp/erbot/contrib/haiku.el @@ -0,0 +1,311 @@ +;; haiku.el --- Semi-random haiku generator + +;; Author: Jose E. Marchesi <jemarch@gnu.org> +;; Maintainer: Jose E. Marchesi <jemarch@gnu.org> + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; Haiku generator for erbot. + +;;; Code: + +(setq erbot-haiku-quotes-1 + '( + "The street-smart seamstress " + "The young Russian bride " + "The substitute nurse " + "The Polish waitress " + "The baroness stirs, " + "The long-legged blonde " + "The dish-water blonde " + "The bow-legged midget " + "The busty brunette " + "The divorcee sighs, " + "The arthritic nun " + "The loquacious nurse " + "The hip-sprung school marm " + "The one-eyed baker " + "The plumber's third wife " + "Traffic stills. The maid " + "Clouds form. The pornstar " + "The stewardess coughs, " + "The Swiss bank teller " + "The stripper pauses, " + "The erstwhile diva " + "The languid bar maid " + "The opera singer " + "The zoologist " + "The Czech spinster " + "His virgin great-aunt " + "His neighbor's young wife " + "The banker's mistress " + "The pregnant midwife " + "The devious moll " + "The shy farmer's wife " + "A cornfed she-spy " + "The juice bar clerk's wife " + "One hillbilly tart " + "The one in the skirt " + "The kiwi au pair " + "The lipstick model " + "A lady from Minsk " + "The gal with Shooter " + "The slatternly nurse " + "The B-movie star " + "The heart-broken girl " + "The star-struck waitress " + "The therapist snores, " + "The stewardess drools, " + "The magnateâs mistress " + "The steel baronâs bride " + "The pianistas niece " + "The Russian cellist " + "The poetess gulps, " + "The Slavic wet nurse " + "Filipino Sue " + "Susannah stretches, " + "The wet nurse sniffles, " + "The clarinetist " + "The drunk southern belle " + "The cheer squad reject " + "The home ec teacher " + "The receptionist " + "The paralegal " + "The street-smart fly girl " + "The redhead stretches, " + "The old-fashioned nun " + "The ice cream lady " + "The sullen milkmaid " + "The vain meter maid " + "The fat Dixie Chick " + "The shy cartoonist " + "The sexy bassist " + "The reclusive aunt " + "The sly lunch lady " + "The Czech go-go girl " + "The short cheerleader " + "The chain-smoking niece " + "The Swiss governess " + "The stone-faced matron " + "The suave landlady " + "Traffic slows. The nun " + "Paint dries. The brunette " + "The other woman " + "The anchorwoman " + "The Russian madam " + "His ex-fiancee " + "The young blushing bride " + "The widow-to-be " + "The drunken bridesmaid " + "The groom's ex-wife sneers, " + "The gap-toothed redneck " + "The night-shift seamstress ")) + + +(setq erbot-haiku-quotes-2 + '( + "removes her prosthetic leg. " + "rolls her tongue, trilling râs, lâs. " + "wakes, deflates the air mattress. " + "bathes in warm crocodile tears. " + "motions with her silver thumb. " + "rouges her razorous cheeks. " + "arches her wrist towards the sky. " + "removes her golden fake nose. " + "stands, coins spilling from her ears. " + "removes her prosthetic leg. " + "rolls her tongue, trilling râs, lâs. " + "wakes, deflates the air mattress. " + "bathes in warm crocodile tears. " + "covers her eyes with sack-cloth. " + "blots her dark lipstick, pauses. " + "calmly sets fire to her hair. " + "hangs her slip on the lanyard. " + "greasens the stubborn crank-shaft. " + "polishes the good flatware. " + "whispers the word âwheelbarrowâ. " + "fingers her silver tongue-stud. " + "dreams of monkeys, gibbons, apes. " + "scrubs the tile floor, knees rasping. " + "speaks in tongues, eyelids twitching. " + "retires to the powder room. " + "dips her tongue in peroxide. " + "displays her elegant gams. " + "exhales a plume of wood-smoke. " + "rings the doorbell, rings again. " + "rubs her feet, closes her eyes. " + "shuffles a stack of scratch cards. " + "grins and waves the poking stick. " + "leans toward the caged man-child. " + "rises, but won't run or blink. " + "shouts lies to baldheaded fools. " + "really needs to get kneaded. " + "quickly dons her happy pants. " + "beckons with a pineapple. " + "brandishes a hair curler. " + "plants the pill beneath the sheets. " + "hides the orange behind the stove. " + "tucks the gem beneath her tongue. " + "eats the lottery ticket. " + "fills the sock drawer with mustard. " + "steals the swear jar, hops a train. ")) + +(setq erbot-haiku-quotes-3 + '( + "Boom-shacka-lacka. " + "Thunderous applause. " + "Dogs dance like comets. " + "The sky fills with stars. " + "Retrograde motion. " + "She sells no sea shells. " + "No room in the inn. " + "Dishes dry in sinks. " + "Snow falls in Utah. " + "Sirens wail, so close. " + "He takes a breath, breathes. " + "His heart swells madly. " + "His ears fill with blood. " + "There is always time. " + "All Iâve got is time. " + "You know the story. " + "The drummer skips town. " + "One more cigarette. " + "The ocean shivers. " + "The dormouse quivers. " + "Rain falls on spring leaves. " + "Pizza boy blushes. " + "The cat fiddles on. " + "A new moon blushes. " + "Somewhere a dog howls. " + "Cats rub themselves mad. " + "Soup boils on the stove. " + "The stove eye glows red. " + "The faucet drips, drips. " + "Cars howl on the street. " + "A car backfires, roars. " + "There is never time. " + "The bouilabaisse chills. " + "Ganja cornbread bakes. " + "People smile and cry. " + "Spacious rooms are filled. " + "Unseen lackeys stir. " + "The burnished door shuts. " + "For the last time, why? " + "Why didn't you stay? " + "Why didn't you leave? " + "Where did the time go? " + "My tongue betrays me. " + "My heart betrays me. " + "The night betrays me. " + "I miss you. Love, me. " + "I've got plenty more. " + "No, itâs not like that. " + "Cry uncle for me. " + "Take two steps backwards. " + "Paper beats rock, fool. " + "Hell, maybe. Who knows. " + "Hit me one more time. " + "My dog has no fleas. " + "Is this all there is? " + "No more soup for you. " + "You buy the next round. " + "A round of applause. " + "Contestants titter. " + "He owns no short-shorts. " + "Pat your head thusly. " + "Never with these eyes. " + "Only with these eyes. " + "We've all gone crazy. " + "Hank Williams was right. " + "It's all circular. " + "Everything is wet. " + "Boom-shacka-lacka. " + "Thunderous applause. " + "Dogs dance like comets. " + "The sky fills with stars. " + "Retrograde motion. " + "She sells no sea shells. " + "No room in the inn. " + "Dishes dry in sinks. " + "Snow falls in Utah. " + "Sirens wail, so close. " + "He takes a breath, breathes. " + "His heart swells madly. " + "His ears fill with blood. " + "There is always time. " + "All I've got is time. " + "You know the story. " + "The drummer skips town. " + "One more cigarette. " + "The ocean shivers. " + "The dormouse quivers. " + "Rain falls on spring leaves. " + "Pizza boy blushes. " + "The cat fiddles on. " + "A new moon blushes. " + "Somewhere a dog howls. " + "Cats rub themselves mad. " + "Soup boils on the stove. " + "The stove eye glows red. " + "The faucet drips, drips. " + "Cars howl on the street. " + "A car backfires, roars. " + "There is never time. " + "The bouilabaisse chills. " + "Ganja cornbread bakes. " + "People smile and cry. " + "Spacious rooms are filled. " + "Unseen lackeys stir. " + "The burnished door shuts. " + "For the last time, why? " + "Why didn't you stay? " + "Why didn't you leave? " + "Where did the time go? " + "My tongue betrays me. " + "My heart betrays me. " + "The night betrays me. " + "I miss you. Love, me. " + "Iâve got plenty more. " + "No, itâs not like that. " + "Cry uncle for me. " + "Take two steps backwards. " + "Paper beats rock, fool. " + "Hell, maybe. Who knows. " + "Hit me one more time. " + "My dog has no fleas. " + "Is this all there is? " + "No more soup for you. " + "You buy the next round. " + "A round of applause. " + "Contestants titter. " + "He owns no short-shorts. " + "Pat your head thusly. " + "Never with these eyes. " + "Only with these eyes. " + "We've all gone crazy. " + "Hank Williams was right. " + "It's all circular. ")) + +(defun fs-haiku (&rest args) + "REST: args" + (format "%s\n%s\n%s" + (erbutils-random erbot-haiku-quotes-1) + (erbutils-random erbot-haiku-quotes-2) + (erbutils-random erbot-haiku-quotes-3)))
\ No newline at end of file diff --git a/elisp/erbot/contrib/idledo.el b/elisp/erbot/contrib/idledo.el new file mode 100644 index 0000000..a75f1c0 --- /dev/null +++ b/elisp/erbot/contrib/idledo.el @@ -0,0 +1,1157 @@ +;;; idledo.el --- do stuff when emacs is idle.. +;; Time-stamp: <2004-11-14 22:37:04 deego> +;; Copyright (C) Deepak Goel 2001 +;; Emacs Lisp Archive entry +;; Filename: idledo.el +;; Package: idledo +;; Author: Deepak Goel <deego@gnufans.org> +;; Keywords: idle startup speed timer +;; Version: 0.3 +;; Author's homepage: http://deego.gnufans.org/~deego +;; REQUIRES: timerfunctions.el 1.2.7 or later. +;; ALSO uses: emacs' ('cl during compile.. for all the backquoting..) +;; For latest version: + +(defvar idledo-home-page + "http://deego.gnufans.org/~deego/emacspub/lisp-mine/idledo") + +;; Requires: timerfunctions.el +;; See also: Jari's tinyload.el, dope.el. + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + + + +;; Quick start: +(defvar idledo-quick-start + "Drop idledo.el and timerfunctions.el somewhere in your +load-path. In your .emacs, type (require 'idledo) and (require +'timerfunctions). In there, also create idledo-list-- a list of +expresions, either by hand, or by using one of the many functions and +macros provided. Then, write (idledo-start), and idledo will start +doing the tasks mentioned in the idledo-list whenever emacs is idle. + +Here, for example, are some +possible lines of code from a .emacs---> + + + (idledo-require 'bbdb 'bbdb-com 'bbdb-gnus) + (idledo-add-action + '(progn (unless (file-locked-p \"~/emacs/.bbdb\") + (bbdb-records)) + nil)) + (idledo-require-now 'mailabbrev) + ;; as below, or simply (idledo-gc) + (idledo-add-action + '(garbage-collect)) + + (idledo-add-action '(load \"aliases-my\")) + + (idledo-add-action '(progn + (garbage-collect) + nil)) + + (idledo-load \"mode-hook-functions-my\") + (add-to-list 'idledo-list '(progn (message \"Just a sample\"))) + (idledo-require 'disp-table) + (idledo-require 'gnus-score 'gnus 'gnus-msg) + +A simple long example is (idledo-example-setup) which can be called +from your .emacs. Alternatively, a more complicated example of how to +set up idledo-list can be seen in the function idledo-example. That +one tries to save even more time by: moving the task of setting up an +idledo-list itself into the first idledo, and on top of that, calls +idledo-start not from emacs, but from an idle-timer. + +To maintain idledo-history, see idledo-after-action-hooks + +This author currently uses exactly 105 idledo's. +PS: timerfunctions.el can be obtained from: +http://deeego.gnufans.org/~deego/emacspub/lisp-mine/timerfunctions/" +) + +(defun idledo-quick-start () + "Provides electric help for function `idledo-quick-start'." + (interactive) + (with-electric-help + '(lambda () (insert idledo-quick-start) nil) "*doc*")) + +;;; Introduction: +;; Stuff that gets posted to gnu.emacs.sources +;; as introduction +(defvar idledo-introduction + "Idledo does stuff for you when emacs is idle. + + +The actions can be simple one-time actions or repetitive. You can +include as many actions as you want. Thus, with apprpriate actions, +if you leave emacs running for sometime, take a break and come back, +your emacs should have (require)'d almost everything you will ever +need..you can now start your gnus or eshell or w3 instantly.. When you +are using gnus, you can check mail periodically.. Make +color-theme-random a periodic idledo and you can convert emacs into a +shapeshifting color-changing aquarium.. + +idledo will probably someday be interfaced with a prioritizer, which +will include all sorts of enhanced capabilites, like weighting of +repetitive actions etc. + +See also M-x idledo-quick-start +" +) + +;;;###autoload +(defun idledo-introduction () + "Provides electric help for function `idledo-introduction'." + (interactive) + (with-electric-help + '(lambda () (insert idledo-introduction) nil) "*doc*")) + +;;; Commentary: +(defvar idledo-commentary + "First type M-x idledo-introduction. +Also see M-x idledo-quick-start + +You give idledo a list of commands, and it will eval them when emacs is +idle and you are away.. Thus, if you take a hike and come back, your +w3, gnus, eshell should all start instantly.. Your gnus-news should +be checked periodically for you.. and *Group* buffer updated.. of +course, you have to set this all up :/) + +If emacs is idle *not* because you are away, but because you are +deeply absorbed using info, you probably don't want idledo springing into +action and loading eshell for you.. So, idledo tries to alert you before +loading anything, and gives you enough time to cancel any action +before it is taken.. + +As an example, see the function idledo-example. I call that function +from my .emacs as follows.. + +/(idledo-example/) + +where: + +Note: If you specify many idle-loads and thus make your emacs very big +with (idle) time, your emacs will get slow and do frequent gc. Some +remedies: + +* First, turn garbage-collection messages on to see what i am sayin, + for yourself: (setq garbage-collection-messages t) in .emacs + +* Next, increase gc-cons-threshold to say, 10 times its value: + (setq gc-cons-threshold 40000000) in .emacs. + +* Finally, ask idledo to do garbage-collections for you when emacs is + idle. See an example in idledo-example-setup. In that example, once + all my other idledo's are taken care of, emacs then alternates + between doing garbage-collection and color-theme-random when it is + idle.. Thus, trying to ensure that when I get back to work, least gc + takes place... + + +0.1 new features: +* Now called idledo, to avoid a name-conflict with another package. + Sorry about that, and Thanks to all who pointed this out. +* Macros like ido-add-require now called idledo-require. +* Minor bug fixed in idledo-add-periodic-action-to-beginning-crud +" ) + +(defun idledo-commentary () + "Provides electric help for function `idledo-commentary'." + (interactive) + (with-electric-help + '(lambda () (insert idledo-commentary) nil) "*doc*")) + +;;; History: + +;;; New features: +(defvar idledo-new-features + "New in 0.3: +Some Bugfixes. Made compatible with the current +timerfunctions.el--posted here. +Improved doc." +) + +(defun idledo-new-features () + "Provides electric help for function `idledo-new-features'." + (interactive) + (with-electric-help + '(lambda () (insert idledo-new-features) nil) "*doc*")) + +(defvar idledo-version "0.3") + +(defvar idledo-todo +"TODO: +* Ideally, one should be able to cancel the timer if idledo-list + becomes nil. + +* Write a prioritizer, and interface the same with idledo. The priotizer + should. among other things like weights and \(arbitrarily specified\) + repetitivity, try to support different idle times for different + tasks.." +) + + +;;========================================== +;;; Code: +(defgroup idledo nil + "idledo.el --- do stuff when emacs is idle.. " + :group 'applications) + +(defcustom idledo-before-load-hooks nil "." + :type 'hook + :group 'idledo + ) +(defcustom idledo-after-load-hooks nil "." + :type 'hook + :group 'idledo + ) +(run-hooks 'idledo-before-load-hooks) +(eval-when-compile (require 'cl)) + +(defcustom idledo-before-action-hooks nil + " + +This hook is run even if idledo-once is callesd byhand. + +" + :type 'hook + :group 'idledo + ) + +(defcustom idledo-before-idle-action-hooks nil + "." + :type 'hook + :group 'idledo + ) + +(defcustom idledo-after-action-hooks nil + "Hooks to run after performing idledo-actions. +You could insert the command idledo-history-update into this hook. +This hook is run even if idledo-once is called by hand. +" + :type 'hook + :group 'idledo) + +(defcustom idledo-after-idle-action-hooks nil + "Hooks to run after performing idledo-actions. +You could insert the command idledo-history-update into this hook. +" + :type 'hook + :group 'idledo) + +(defcustom idledo-before-possible-action-hooks nil "." + :type 'hook + :group 'idledo) + +(defcustom idledo-after-possible-action-hooks nil "." + :type 'hook + :group 'idledo) + + + +(defcustom idledo-list nil + "A list of actions to perform.." + :type 'list + :group 'idledo + ) + + +(defcustom idledo-verbosity 0 + "Suggested: Anywhere from -100 to 100. + +The design is such that a value of 0 should be optimum. +viz.: Once you are experienced with this library, you might prefer a value +of 0 for this variable if this is > 0 right now." + :type 'integer + :group 'idledo +) + +(defvar idledo-active-p nil + "If t, no more idledo's can be initiated.. +The aim is to only have one idledo active at a time. + +Why? I don't know. You can easily setq this to nil, and start yet +another `idledo-start' if you want. + +Why do i want only one idledo at a time? My experience is that \(GNU\) +Emacs bahaves unpredictably if the activation of 2 or more timers +collide... maybe i am wrong? It seems to me that sometimes, both get +executed, someimtes one, and sometimes none.. Although the one or +none situations seem to be rare, each of thses situations can be +potentially bad..particularly if: Suppose the timer is a +self-reinforcing timer \(as can be done by calls to +`tf-run-with-idle-timer'\). Then, the very first time it fails to get +executed, the process gets killed and you want get those cherished +repetitions as long as Emacs remains idle.." +) + +(defcustom idledo-interval 30 + "The interval to wait the first time Emacs goes idle.. +An additional small interval will be allowed to enable the user to +cancel the action. + +Note that you can assign to this this interval any expression that +will be eval'ed at run-time \(see timerfunctions.el for more details..\)" + :type 'list + :group 'idledo +) + +(defcustom idledo-interval-subsequent 1 + "When Emacs remains idle, time to wait before next action. + +Time is in seconds.. floats might work too. +Note that you can assign to this this interval any expression that +will be eval'ed at run-time \(see timerfunctions.el for more details..\)" + :type 'list + :group 'idledo +) + +(defcustom idledo-interval-small 5 + "Time to warn for before performing the imminent idledo. + +Before beginning any action, idledo will flash a warning, and will +wait for these many seconds.. if you do something in this time, the +action will be cancelled. + +Note that you can assign to this this interval any expression that +will be eval'ed at run-time \(see timerfunctions.el for more details..\)" :type 'hook + :group 'idledo +) + +(defvar idledo-timer nil + "The timer stored here.. so can be cancelled.. Internal..") + +(defvar idledo-last-action nil + "Will store the last action. +--if the user needs this for any purpose. ") +(defvar idledo-last-result nil + "The result of the eval of the last idledo-action. +provided in case the user needs this. ") + +(defvar idledo-history nil + "Stores, optionally, the reverse-history of idledo-actions and their +results. ") + +(defcustom idledo-history-max-length 100 + "Max length of history to maintain. Nil means no limit. +When length exceeded, oldest entries are discarded. " +:group 'idledo +) + +(defvar idledo-counter 0 + "The number of idledos performed. ") + + + +(defun idledo-history () + (interactive) + (message "idledo-counter: %S idledo-history: %S" + idledo-counter idledo-history)) + +(defun idledo-history-update () + (interactive) + (push (list (copy-tree idledo-last-action) + (copy-tree idledo-last-result)) + idledo-history) + (setq idledo-counter (+ 1 idledo-counter)) + (while (and (integerp idledo-history-max-length) + (> (length idledo-history) idledo-history-max-length)) + (setq idledo-history (reverse (cdr (reverse idledo-history)))))) + + +(defun idledo-start-forced-risky () + "Internal. +USED ONLY FOR DEBUGGING.. USE AT YOUR OWN RISK.. STARTS A PARALLEL +version of idledo if there already exists one..." + (interactive) + (tf-run-with-idle-timer + 'idledo-interval t + 'idledo-interval-subsequent + t nil + 'idledo-one-action)) + + +;;;###autoload +(defun idledo-stop () + "Stop any idledo." + (interactive) + (when (timerp idledo-timer) + (cancel-timer idledo-timer)) + (setq idledo-active-p nil)) + + + +;;;###autoload +(defun idledo-start () + "Start idledo. + +See also `idledo-active-p'. Also returns the timer." + (interactive) + (if (not idledo-active-p) + (progn + (idledo-stop) + (setq idledo-active-p t) + (setq idledo-timer + (tf-run-with-idle-timer + 'idledo-interval t + 'idledo-interval-subsequent + t nil + 'idledo-one-action))) + (error "Idledo is already active"))) + +(defcustom idledo-interval-done 1 + "Time to wait before showing the 'done' message. +Idledo will wait for this much time before flashing a 'done-action' +message" + :group 'idledo +) + + +(defcustom idledo-action-imminent-string + "idledo imminent unless keypress ---> " + "The `idledo-action-imminent-string'." + :type 'string + :group 'idledo +) + +(defun idledo-one-action () + "Internal. +Does one instance of processing of action." + (when (not (null idledo-list)) + (run-hooks 'idledo-before-possible-action-hooks) + (idledo-message 25 + (concat idledo-action-imminent-string + (idledo-shorten (format "%S" (car idledo-list))))) + (if (sit-for idledo-interval-small) + (progn + (run-hooks 'idledo-before-idle-action-hooks) + (idledo-once 1) + (run-hooks 'idledo-after-idle-action-hooks) + (sit-for idledo-interval-done) + (idledo-message 60 "%S more idledo(s) remainig.. " + (length idledo-list))) + + + (idledo-message 20 + (concat "IDLEDO's action canceled.." + (idledo-shorten (format "%S" (car idledo-list))))) + ) + (run-hooks 'idledo-after-possible-action-hooks))) + +(defun idledo-all () + "Tell the amount of time saved through idledo's. +Start emacs and run M-x idledo-all. That will run all your +idledo's at once and show you how much time all of that took. + +More like, it will run as many idledo's as there are currently in +your idledo-list, which may not correspond to ALL idledo's since you +may have repetitive idledo's" + (interactive) + (let ((ta (current-time)) + (len (length idledo-list)) + tb tott) + (idledo-once len) + (setq tb (current-time)) + (setq tott (idledo-time-diff tb ta)) + (message "That took %S milliseconds. " tott))) + + +(defun idledo-time-diff (tb ta) + "Get the difference bet times TB and TA, in milliseconds. A float." + (+ + (* 0.001 (- (caddr tb) (caddr ta))) + (* 1000.0 + (+ + (- (second tb) (second ta)) + (* 65536.0 + (- (car tb) (car ta))))))) + +;;;###autoload +(defun idledo-once (arg) + "Call this if you wanna run something in yr `idledo-list' NOW... +Provide numerical prefix ARG for multiple arguments... +but note that doesn't run after-action hooks etc." + (interactive "p") + (while + (>= arg 1) + (setq arg (- arg 1)) + (run-hooks 'idledo-before-action-hooks) + (progn + (idledo-message 20 + (concat "IDLEDO doing action.." + (idledo-shorten (format "%S" (car idledo-list))))) + (let ((carval (car idledo-list))) + (setq idledo-last-action carval) + (setq idledo-list (cdr idledo-list)) + (setq idledo-last-result + (idledo-ignore-errors (eval carval))))) + (run-hooks 'idledo-after-action-hooks) + + )) + + + +(defun idledo-add-periodic-action-crude (action) + "Add a action to `idledo-list' to be repeated endlessly. +Is a crude mechanism for adding action to the `idledo-list' and make it +repetitive. ACTION is a (quoted) list which will be evaled to perform an +eval. + +Note that the ACTION this way is added to the END of `idledo-list'. +And ACTION is added to list no matter what (even if there is a similar +action already waiting in the list)." + (setq + idledo-list + (append + idledo-list + (list + `(progn + ,action + (idledo-add-periodic-action-crude + (quote ,action))))))) + +(defun idledo-add-periodic-action-to-beginning-crude (action) + "Add an action to `idledo-list' to be repeated endlessly. + +Is a crude mechanism for adding action to the `idledo-list' and make it +periodic. ACTION is a list which will be evaled to perform an +eval. +Note that the ACTION this way is added to the BEGINNING and subsequent +calls are also added to the beginning of the list. +And ACTION is added to list no matter what (even if there is a similar +action already waiting in the list)." + (idledo-add-action-forced + `(progn + ,action + (idledo-add-periodic-action-to-beginning-crude + (quote ,action))))) + + + + +;;;###autoload +(defun idledo-add-to-end-of-list (list-var element) + "Like `add-to-list', but add at the end, if at all. + +Add to the end of the list LIST-VAR, the element ELEMENT" + (if (member element (symbol-value list-var)) + (symbol-value list-var) + (set list-var (append (symbol-value list-var) (list element))))) + +(defun idledo-add-action (action) + "Add ACTION to ideldo-list. + +ACTION is an expression to be evaled. Action is added at the +beginning if at all. See similar commands too." + (add-to-list 'idledo-list action)) + +(defun idledo-add-action-forced (action) + "Add action ACTION to `idledo-list' even if it already exists." + (setq idledo-list (cons action idledo-list))) + +(defun idledo-add-action-at-end (&rest actions) + "Add actions ACTIONS to the end of `idledo-list'." + (mapcar + (lambda (action) + (idledo-add-to-end-of-list 'idledo-list action)) + actions)) + +(defmacro idledo-load (&rest files) + "Add, for each of FILES, a (load file) action to `idledo-list'." + (cons 'progn + (mapcar + (lambda (arg) + `(idledo-add-action-at-end '(load ,arg))) + files))) + +;;; 2001-11-03 T13:42:01-0500 (Saturday) Deepak Goel +(defmacro idledo-load-now (&rest files) + "Add, for each of FILES, a (load-file) action to `idledo-list'. + +The action is added to the beginning of `idledo-list'." + (cons 'progn + (mapcar + (lambda (arg) + `(idledo-add-action '(load ,arg))) + files))) + + +(defmacro idledo-require (&rest features) + "Add, for each of the FEATURES, a (require) action to `idledo-list'." + (cons 'progn + (mapcar + (lambda (arg) + `(idledo-add-action-at-end '(require ,arg))) + features))) + + +(defmacro idledo-require-now (feature) + "Add a (require FEATURE) action to `idledo-list'. + +The addition is done to the beginning of `idledo-list'." + `(idledo-add-action '(require ,feature))) + +(defun idledo-add-action-at-end-forced (action) + "Add ACTION to the end of `idledo-list'. + +Action is added even if it exists in the list already." + (setq idledo-list (append idledo-list (list action)))) + +(defun idledo-initialize (initial-list) + "Initialize `idledo-list' to INITIAL-LIST." + (setq idledo-list initial-list)) + +(defun idledo-remove-action (action) + "Remove ACTION from `idledo-list'." + (idledo-remove-from-list 'idledo-list action)) + +(defun idledo-remove-from-list (listname elt) + "INTERNAL. + +Remove, from list LISTNAME, element ELT." + (set listname (idledo-list-without-element + (eval listname) + elt))) + +(defun idledo-list-without-element (list elt) + "INTERNAL. +Returns the value of the LIST without the element ELT." + (if (null list) + list + (if (equal (car list) elt) + (idledo-list-without-element (cdr list) elt) + (cons + (car list) + (idledo-list-without-element + (cdr list) elt))))) + + +;; Thanks to Kim F. Storm for the suggestion: +(defun idledo-gc () + (idledo-add-action '(garbage-collect))) + +(defun idledo-shorten (string) + "Internal, return a shortened version with no newlines. +Internal, returns a shortened version of STRING with no newlines." + (let + ((string-no-enter + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (while (search-forward "\n" nil t) + (replace-match " " nil t)) + (buffer-substring (point-min) (point-max))))) + (if (> (length string-no-enter) 55) + (substring string-no-enter 0 55) + string-no-enter))) + + +(defcustom idledo-ignore-errors-p t + "This should always be t unless you know what you are doing. + +For regular idledo's if this is not t and an error occurs, this means +that your entire idle-timer might get canceled due to the error. The +only place where this = nil makes sense is when you are running M-x +idledo-once by hand and want to debug the idledo action which is +giving you an error. See also idledo-toggle-ignore-errors.") + +(defun idledo-toggle-ignore-errors-p (&optional arg) + "See idledo-ignore-errors-p. " + (interactive "P") + (let ((num (prefix-numeric-value arg))) + (cond + ((or (not arg) (equal num 0)) + (setq idledo-ignore-errors-p (not idledo-ignore-errors-p))) + ((> num 0) (set idledo-ignore-errors-p t)) + ((< num 0) (set idledo-ignore-errors-p nil))) + (message "Symbol %S set to %S" + 'idledo-ignore-errors-p + idledo-ignore-errors-p) + idledo-ignore-errors-p)) + + +(defmacro idledo-ignore-errors (&rest body) + "Like `ignore-errors', but tell the error.. + +A wrapper around the BODY." + + (if idledo-ignore-errors-p + (let ((err (gensym))) + `(condition-case ,err (progn ,@body) + (error + (ding t) + (ding t) + (ding t) + (idledo-message 90 "IGNORED ERROR: %s" + (error-message-string ,err)) + (sit-for 1) + nil))) + `(progn ,@body))) + + +;;;###autoload +(defun idledo-example () + "Sample of code to include in your .emacs.. +See this and `idledo-example-setup'. +Define a similar function idledo-yourname for yourself in your .emacs, +and call it in yr .emacs by inserting (idledo-yourname) somewhere. + +See \\[idledo-quick-start] for simple examples. + +This function tries to go one step further to and defers the setting +up of the `idledo-list' itself to a time when Emacs goes idle, so as to +try to save more .emacs loading time." + (interactive) + (message "Setting up idledo and starting it..") + ;; testing + ;;(setq idledo-interval 300) + + ;;(setq idledo-list nil) + (idledo-add-action-at-end '(idledo-example-setup)) + + + (setq idledo-action-imminent-string + "idledo imminent--> ") + (idledo-start) + (message "Setting up idledo and starting it..done") + +) + + + +(defun idledo-message (points &rest args) + "Signal message, depending on POINTS and `idledo-verbosity'. +ARGS are passed to `message'." + (unless (minusp (+ points idledo-verbosity)) + (apply #'message args))) + +(defcustom idledo-message-nice-sit 1 "" :group 'idledo) + +(defun idledo-message-nice (points &rest args) + (unless (minusp (+ points idledo-verbosity)) + (with-temp-message (apply 'format args) + (sit-for 0.5)))) + +;;;###autoload +(defun idledo-length-list () + "For you to quickly find the length of idledo-list.. +If you use idledo bigtime, you will frequently find yourself wanting +to find out the length.. and you don't want to eval that parenthesised +expression all the time.. perhaps.." + (interactive) + (idledo-message + (if (interactive-p) 135 35) + "%s" + (format "Length= %S ... %S..." (length idledo-list) + (first idledo-list))) + (length idledo-list)) + + + + + + + + + + + + + + +(defun idledo-example-setup () + "Called by `idledo-example'. +This extra step is taken so that setting +up idledo itself takes place only when Emacs has gone idle.. +This function is actually used by this user's .emacs. +" + ;; The preference in all of below should be to load stuff that takes + ;; time asap.. small libraries can always be loaded later.. or even + ;; if they are not loaded, they do not make the user wait anyways + ;; when they finally get loaded.. + + ;; once bbdb is loaded.. let's get the frobnicating stuff over with.. + + ;; made interactive only for test purposes.. + (interactive) + + ;; hm, i now prefer directly setting the idledo list... + + + (idledo-gc) + + (idledo-require 'bbdb 'bbdb-com 'bbdb-gnus) + (idledo-add-action + '(progn + (require 'bbdb) + (when (boundp 'bbdb-file) + (unless (file-locked-p bbdb-file) + (bbdb-records))) + nil)) + (idledo-require-now 'mailabbrev) + (idledo-add-action '(progn + (garbage-collect) + nil)) + (idledo-load "gnus-functions-my") + (idledo-load "macros-my") + (idledo-add-action '(load "aliases-my")) + (idledo-gc) + + (idledo-load "mode-hook-functions-my") + (idledo-require 'disp-table) + (idledo-require 'gnus-score 'gnus 'gnus-msg) + (idledo-require 'gnus-cache) + (idledo-require 'gnus-ml 'gnus-cite) + (idledo-require 'timerfunctions) + + ;;maybe emacs needs a GC now.. we need to make sure GC is done when + ;;emacs is idle.. + (idledo-gc) + + (idledo-require 'esh-mode + 'em-alias) + + (idledo-require 'em-banner 'em-basic 'em-cmpl 'em-dirs 'em-glob + 'em-hist 'em-ls 'em-prompt 'em-script 'em-term + 'em-xtra 'etags + 'ange-ftp + ;; no longer needed since pcomplete is now bundled + ;; with emacs (21..) + ;;'pcmpl-auto + 'pcomplete + ;; 2002-05-02 T11:57:07-0400 (Thursday) D. Goel + 'shellhist + ;; 2002-05-02 T11:57:25-0400 (Thursday) D. Goel + 'pcmpl-unix + + ;; no longer needed since eshell is now bundled + ;; with emacs (21) + ;;'eshell-auto + + 'em-unix 'bytecomp 'eshell 'runshell ) + (idledo-add-action '(progn + (garbage-collect) + nil)) + (idledo-add-action '(progn + (recentf-mode 1) + nil)) + (idledo-load "cl-seq") + + (idledo-require 'autokey) + (idledo-require 'thingatpt 'ispell 'info) + (idledo-require 'elder) + + (idledo-require 'mail-extr ) + (idledo-require 'autorevert 'view) + (idledo-require 'time-stamp ) + (idledo-require 'imenu) + (idledo-load "kinsoku") + (idledo-require 'edlib ) + (idledo-require 'phonemode) + (idledo-add-action '(progn + (garbage-collect) + nil)) + + ;; bytecomp should be required before this... + (idledo-add-action-at-end '(load "byte-opt")) + + ;;(idledo-load 'tex-mode) + (idledo-require 'boxquote) + (idledo-require 'dired) + (idledo-require 'dired-x) + (idledo-require 'bytecomp) + (idledo-require 'find-func) + (idledo-require 'diff 'diff-mode) + (idledo-require 'add-log) + (idledo-require 'calendar) + (idledo-require 'mule-util) + (idledo-require 'cal-move) + (idledo-require 'advice) + (idledo-require 'browse-kill-ring) + ;; add for fsbot + (idledo-require 'browse-url) + (idledo-add-action '(progn + (garbage-collect) + nil)) + + (idledo-require 'debug) + ;;(idledo-require 'ell) + (idledo-require 'table) + (idledo-require 'tabify) + (idledo-require 'edebug) + ;; 2002-04-25 T15:43:21-0400 (Thursday) Deepak Goel + ;; this will shorten the time it takes to find a tag.. + (idledo-add-action + '(progn + (visit-tags-table "~/TAGS") + nil)) + (idledo-require 'gnus-cus) + (idledo-require 'gnus-async) + ;;(idledo-require 'smiley) + ;;(idledo-add-action + ;;(progn + ;; (require 'smiley "smiley-ems") + ;;nil)) + (idledo-require 'cus-edit) + (idledo-require 'newcomment) + (idledo-require 'genauto) + (idledo-require 'mkback) + (idledo-add-action '(progn + (mkback-install-for-eshell) + nil)) + (idledo-require 'flow-fill) + (idledo-require 'findutils) + (idledo-require 'erc) + (idledo-add-periodic-action-crude + '(progn + (garbage-collect) nil)) + + ; (idledo-add-action + ; '(progn + ; (numshift-install) + ; nil)) + (idledo-add-action + '(progn + (if (display-mouse-p) + (mouse-avoidance-mode 'animate)) + nil)) + (idledo-add-action + '(progn + (iswitchb-mode 1) + nil)) + (idledo-require 'spook) + (idledo-require 'autoinsert) + (idledo-require 'sregex) + (idledo-require 'choose) + (idledo-require 'erc-complete) + (idledo-require 'buffer-stack) + (idledo-require 'emacs-wiki) + (idledo-require 'planner) + (idledo-add-action + '(progn + (require 'eldoc) + (utils-add-minor-mode 'lisp-mode 'eldoc-mode) + (utils-add-minor-mode 'emacs-lisp-mode 'eldoc-mode))) + + + + (idledo-add-action '(progn + (global-font-lock-mode t) + nil)) + + + (idledo-add-action + '(progn + (if + (locate-library "bbdb" nil nil) + (require 'bbdb) + (message "NO BBDB found...")) + nil)) + + + (idledo-add-action + (progn + ;; CVS's type break currently has an annoying "sabve file? " + ;; question. + (when (< emacs-minor-version 3) + (type-break-mode 1)) + nil)) + + (idledo-require 'emacs-wiki) + + + ;; top priority stuff... + (idledo-add-action + '(progn + ;; do we still need all of these for emacs21? + (ignore-errors-my + (add-to-list 'ispell-skip-region-alist + '("\\\\[a-z]?ref{". "}")) + (add-to-list 'ispell-skip-region-alist + '("\\[\\[\\$". "\\$\\]\\]")) ; for latex.. + (add-to-list 'ispell-skip-region-alist + '("\\\\[a-z]?cite{". "}")) + (add-to-list 'ispell-skip-region-alist + '("\\\\begin{al[a-z]*}" . "\\\\end{al[a-z]*}")) + (add-to-list 'ispell-skip-region-alist + '("(\\[ebf\\]ll". "\\[eef\\])")) ; see the function + ; regexp-quote.. + ))) + + + (idledo-add-action + '(windmove-default-keybindings)) + ;;(idledo-add-action + ;;`(progn + ;; (load "chess-auto") + ;; nil)) + ;;(idledo-require 'scroll-in-place) + (idledo-require 'auto-recompile) + (idledo-add-action + '(progn + (require 'elder-beautify) + (elder-beautify-latex) + nil)) + + (idledo-add-action + (progn + (ignore-errors-my (elder-editing-modes)) + nil)) + + + ;; NB: that these are just autoload-definitions.. so their only use + ;; is really for fsbot. + (idledo-require 'calc) + (idledo-require 'calc-ext) + + ;;(idledo-require 'elder-set-keys) + + ;; at the very end.. we want this! + (idledo-add-action + '(progn + (icomplete-mode 1) + nil)) + + (idledo-require-now 'fetch) + + (idledo-require 'emacs-wiki) + + + (idledo-require 'boxquote) + (idledo-require 'assoc) + (idledo-require 'spam-stat) + ;; for fsbot + (idledo-require 'cc-mode) + (idledo-require 'custom) + + (idledo-require 'repeat) + (idledo-require 'thinks) + (idledo-add-action '(mwheel-install)) + (idledo-add-action + '(progn + (setq vel-verbosity 0) + (setq vel-echo-status-p t) + (require 'vel) + (setq-default vel-mode t))) + + (idledo-add-action + '(progn + (auto-compression-mode 1) + nil)) + (idledo-require 'windmove) + (idledo-add-action + '(windmove-default-keybindings)) + + + + (idledo-require 'parse-time) + ;;(idledo-add-action + ;;'(progn + ;; (require 'color-theme) + ;;(color-theme-parus) + ;;(color-theme-fischmeister) + ;;(color-theme-gray1) + ;;(utils-color-theme-nice-random-contextual) + ;;)) + + +;; (idledo-add-periodic-action-crude +;; '(progn +;; (setq idledo-verbosity -100) +;; (utils-color-theme-random-contextual) nil)) + + ;; (idledo-add-action + ;; '(utils-color-theme-nice-random-contextual)) + + (idledo-add-periodic-action-crude + '(progn + (require 'diary-lib) + (require 'appt) + (diary) + (message (format "%S" appt-time-msg-list)) + (appt-check) + + )) + + + ;; initialize woman.. + (idledo-add-action-at-end + '(when (sit-for 300) + (require 'woman) + (woman-file-name ""))) + + + + +;; (idledo-add-action +;; '(progn +;; (require 'remem) +;; (remem-toggle))) + + + + (idledo-add-action + '(progn + (tabbar-mode 1))) + + + (idledo-add-action + '(when window-system + (require 'highlight-tail) + (call-interactively 'highlight-tail-mode 1))) + + + (idledo-add-action '(dabbrev-hover-install t t)) + + + ;; top priority + (idledo-add-action + '(progn + (require 'fetch) + (miniedit-install) + (fetch-install-for-eshell) + (mkback-install-for-eshell) + nil)) + + + + + (idledo-add-action-at-end + '(when (sit-for 4200) + (when (or (not (fboundp 'gnus-alive-p)) + (not (gnus-alive-p))) + (spam-stat-doit-my)))) + + ) + + + + +;;;###autoload +(defun idledo-nullify () + (interactive) + (setq idledo-list nil) + (message "Idledo-list set to nil")) + + +(provide 'idledo) +(run-hooks 'idledo-after-load-hooks) +;;; idledo.el ends here diff --git a/elisp/erbot/contrib/lines.el b/elisp/erbot/contrib/lines.el new file mode 100644 index 0000000..f938c49 --- /dev/null +++ b/elisp/erbot/contrib/lines.el @@ -0,0 +1,586 @@ +;;; Lines.el -- help deal with data-files. OLDER VERSIONS SECURITY RISK +;;General Public License. +;; Time-stamp: <2004-11-21 11:11:45 deego> +;; GPL'ed under GNU'S public license.. +;; Copyright (C) Deepak Goel 2000 +;; Emacs Lisp Archive entry +;; Filename: lines.el +;; Author: Deepak Goel <deego@glue.umd.edu> +;; Version: 0.3alpha + +;; OLDER VERSIONS OF LINES.EL AREx A SECURITY RISK. IF YOU USE THEM +;; TO FETCH FIELD FROM SOME ONE ELSE'S FILE , CRAFTY EXPRESSIONS CAN +;; MAKE YOUR EMACS EVALUATE ANYTHING, INCLUDING (SHELL-COMMAND "RM +;; -RF")). WE JUST THINK SO, WE HAVEN'T BEEN ABLE TO ACTUALLY COME UP +;; WITH AN EXPLOIT. SO USE version > 0.3 only + +;; EVEN THIS LIBRARY IS A POSSIBLE SECURITY RISK TOO IF YOU DISABLE +;; LINES-SAFE-P. + + + +(defvar lines-version "0.3alpha") + +;;; See also: forms.el (just saw it.. maybe it does all that lines.el +;; does ?) + + +;;;COMMENTARY: lines functions to help deal with data-files.. + +;;; Sometimes you want to use lines- functions instead of point- +;;; functions, even though it is slower. Particularly if u r dealing with +;;; parsing/editing a data-file, with, say data arranged in columns. +;;; lines.el defines most lines- counterparts of (point-max) (point-min) +;;; (point) (kill-region) etc. [for instance, emacs' default lines-what +;;; does not return an integer, which is what u may want during +;;; programming] + +;;; Lines.el also defines functions such as lines-get-fields (which gets +;;; all fields on this line, assuming they are lisp-expressions). + + +;;; BEFORE DOING ANYTHING WITH A BUFFER, please do not forget to call +;;;; lines-narrow-initial.. + + + +;;; CODE: +(eval-when-compile (require 'cl)) + +;;;###autoload +(defmacro lines-ignore-errors (&rest body) + "Copied from utils.el + +Like ignore-errors, but returns a list of body, and the +error... Improved for me by Kalle on 7/3/01: * used backquote: +something i was too lazy to convert my macro to.. * removed the +progn: condition-case automatically has one.. * made sure that +the return is nil.. just as it is in ignore-errors. " + (let ((err (gensym))) + `(condition-case ,err (list (progn ,@body) nil) + (error + (list nil ,err))))) + + +(defmacro lines-with-string (string &rest body) + "This macro treats the string as a buffer... basically, it +temporarily puts the string into a temp-buffer and runs body on it... +Note that when the body is being run, the point is (initially) at the +end of the buffer... " + `(with-temp-buffer + (insert ,string) + ,@body)) + + +(defun lines-empty-error () + "" + (error "Empty buffer. NOTE: M-x lines-warning.") +) + +(defun lines-warning () + "" + (let ((lines-loudness 1)) + (lines-message + "THIS program assumes that the proper form of the (data-) file you + examine ends in \\n. Anything in your file after the last \\n + will be ignored.")) +) + +;;;Mon Jan 15 04:09:30 2001 +;;;###autoload +(defun lines-widen () + (widen) +) + +;;;Mon Jan 15 03:32:05 2001 +;;;###autoload +(defun lines-narrow-initial (&optional ERR) + "Narrows such that the last char is a \\n +If the buffer survives, returns the size of the buffer, else nil. +Optional arg ERR results in ERR upon empty buffer. +FOR FUTURE EDITS: NEVER CALL OTHER LINES FUNCTIONS WITHIN THIS +FUNCTION, THIS ONE IS CALLED BY ALL OTHERS! + +" + (interactive) + (save-excursion + (let + ((lastn + (progn + (goto-char (point-max)) + (if + (search-backward "\n" nil t) + (+ (point) 1) + (point-min))))) + (narrow-to-region (point-min) lastn)) + (if (> (point-max) (point-min)) + (point-max) + nil)) +) + + +(defvar lines-loudness 0.6 "Tells you how noisy lines will be.. +Between 0 and 1 are meaningful values") + +(defun lines-message (&optional args) + (if (> lines-loudness 0.5) (apply 'message args)) +) + + +;;;###autoload +(defalias 'lines-what-line 'lines-what) + +;;;Wed Jan 17 00:11:38 2001 +;;;###autoload +(defun lines-what-narrowed (&optional given-point ) + " Like lines-what-line, except assumes a narrowed buffer. +Mostly like what-line, except: returns integer! +Tells you the current line.. If narrowed, assumes that the first +visible line is number 1.. As if the buffer were the entire buffer.. +Respects narrowing.. + +If DONTNARROW is t, assume that lines has already been narrowed.. +" + (interactive) + (let ((opoint (if given-point given-point (point))) + start) + (save-excursion + (goto-char (point-min)) + (beginning-of-line) + (setq start (point)) + (goto-char opoint) + (beginning-of-line) + (let + ((result + (if (/= start 1) + (1+ (count-lines start (point))) + (1+ (count-lines start (point)))))) + (if (interactive-p) + (message (format "%S" result))) + result))) + ) + +;;;Wed Jan 17 00:11:38 2001 +;;;###autoload +(defun lines-what(&optional given-point ) + " Mostly like what-line, except: returns integer! +Tells you the current line.. Ignores any narrowing when counting +lines, but does not disrupt the narrowing.. + +Hacked from the code of what-line, and i still don't understand some +stuff about the relevance of start here.. + +Thus, even if the buffer has been narrowed, lines-what will try to +return the true line-number.. Agreed this may slow things down for +large files, but makes sense to me.. if u don't like this, please +consider using lines-what-narrowed.. + +In the new emacsen, see also `line-at-pos'. +" + (interactive) + (let ((opoint (if given-point given-point (point))) + start) + (save-excursion + (goto-char (point-min)) + (beginning-of-line) + (setq start (point)) + (goto-char opoint) + (beginning-of-line) + (let + ((result + (if (/= start 1) + (1+ (count-lines 1 (point))) + (1+ (count-lines 1 (point)))))) + (if (interactive-p) + (message (format "%S" result))) + result))) + ) + + +;;;###autoload +(defalias 'lines-line-difference 'lines-difference) + +;;;###autoload +(defun lines-difference (start end ) + "Nothing more than the difference between the line at start and the +one at end. start and end are points.. See also the default +count-lines.. +If DONTNARROW is t, assume that lines has already been narrowed.. + +" + (save-excursion + (- (lines-what-line end ) + (lines-what-line start ))) + ) + + +;;;###autoload +(defalias 'lines-last-line-p 'lines-last-p) + +;;;###autoload +(defun lines-last-p () +" Tells if we are on the last line. " + (interactive) + (save-excursion + (end-of-line) + (equal (point) (point-max))) + ) + +;;;###autoload +(defalias 'lines-first-line-p 'lines-first-p) + +;;;###autoload +(defun lines-first-p () +"If DONTNARROW is t, assume that lines has already been narrowed.." + (interactive) + (save-excursion + (beginning-of-line) + (equal (point) (point-min))) +) + +;;;###autoload +(defalias 'lines-line-min 'lines-min) + +;;;###autoload +(defun lines-min () + "Like point-min.. +If DONTNARROW is t, assume that lines has already been narrowed.. + +" + (interactive) + (save-excursion + (goto-char (point-min)) + (lines-what-line (point) )) +) + +;;;###autoload +(defalias 'lines-line-max 'lines-max) + +(defun lines-max () + "Like point-max +If DONTNARROW is t, assume that lines has already been narrowed.. +" + (interactive) + (save-excursion + (goto-char (point-max)) + (lines-what-line (point) )) +) + + +;;;Tue Jan 16 11:26:30 2001 +;;;###autoload +(defalias 'lines-kill-this 'lines-kill-one) + +;;;Tue Jan 16 11:26:26 2001 +;;;###autoload +(defun lines-kill-one (&optional pt1 ) + (interactive) + (if (null pt1) + (setq pt1 (point))) + (lines-kill pt1 pt1 )) + + +;;;Tue Jan 16 11:50:55 2001 +;;;###autoload +(defun lines-kill-by-lines (&optional l1 l2 ) + "Kills from line1 to line2. If l1 or l2 is not specified, passes nil to +lines-kill.. + +Use this function only if necessary.. +This function calls line-kill.. which is the one to be preferred for +speed.. + +" + (save-excursion + (let + ((pt1 + (if (null l1) nil + (progn + (goto-line l1) + (point)))) + (pt2 + (if (null l2) nil + (progn + (goto-line l2) + (point))))) + (lines-kill pt1 pt2 ))) + ) + + + + +;;;Tue Jan 16 11:26:22 2001 +;;;###autoload +(defalias 'lines-kill-line 'lines-kill-one) + + +;;;###autoload +(defun lines-kill (&optional pt1 pt2 ) + "Kills this line completely. + +If PT1 and PT2 are specified, kills all lines through the line on PT1 +to line on PT2, inclusive. + +If neither PT1 is not specified, kills between point and mark. + +If only PT1 is specified, and PT2 is nil, takes PT2 to be PT1, +viz. kills the line on PT1. + + +If DONTNARROW is t, assume that buffer has already been narrowed +initially. + +If the second point to be killed is point-max, viz. is at a line we +don't consider to be on the buffer, this function appropriately +subtracts 1 from it so as to make it a part of the last legal line. + +" + (interactive) + (when (null pt1) + (setq pt1 (mark)) + (setq pt2 (point))) + (when (null pt1) ;;if mark is undefined.. + (setq pt1 pt2)) + (lines-swap-if-necc 'pt1 'pt2) ;;;ensure pt1 <= pt2. + (if (= pt2 (point-max)) (setq pt2 (- pt2 1))) + (if (= pt1 (point-max)) (setq pt1 (- pt1 1))) + (save-excursion + (let ((a1 + (progn + (goto-char pt1) + (beginning-of-line) + (point))) + (a2 + (progn + (goto-char pt2) + (end-of-line) + (+ (point) 1)))) + (kill-region a1 a2))) + ) + + + + + +(defun lines-backward-char () + "Moves one point back. Returns point if succeeds, else nil. +Never gives error! +Actually, i don't think we need this function.. +" + (interactive) + (let ((pt (point))) + (ignore-errors (backward-char 1)) + (if (/= (point) pt) + pt + nil)) + ) + +;;;Tue Jan 16 17:35:29 2001 +;;;###autoload +(defun lines-get-fields-by-lines (&optional line) + "Gets the field on the given line" + (lines-get-fields (lines-point-for-line line)) +) + + +;;;Thu Feb 8 14:48:47 2001 +;;;###autoload +(defun lines-point-for-line (line) + (save-excursion + (goto-line line) + (point))) + +(defcustom lines-safe-p t + "Set to t to revert to an unsafe, older but faster method of using + lines. ") + +;;;Mon Jan 15 02:42:19 2001 +;;;###autoload +(defun lines-get-fields (&optional pt ) + "Gets the fields if any on the current line, as a list. +Uses scan-sexps==> +will be affected by the value of parse-sexp-ignore-comments.. + +I think this needs to be totally rewritten.. to give the same results, +but much more efficiently.. +" + (interactive) + (let (fields fld buf fld-err err) + (if (null pt) (setq pt (point))) + (if (= pt (point-max)) + (goto-char (- pt 1))) + (save-excursion + (goto-char pt) + (let ((expr (lines-at-point )) + fields) + (cond + (lines-safe-p + (with-temp-buffer + (setq buf (current-buffer)) + (insert expr) + (goto-char (point-min)) + (while + (progn + (setq fld-err + (lines-ignore-errors (read buf))) + (setq fld (car fld-err)) + (setq err (cadr fld-err)) + (not err)) + (push fld fields))) + (setq fields (reverse fields))) + (t + (if (null expr) + (error "Attempt to get fields beyond the last RET ")) + (with-temp-buffer + (insert "(setq fields (quote (") + (insert expr) + (insert " \n)))") + (eval-buffer)))) + (if (interactive-p) (message "%S" fields)) + fields)))) +;;; (let ((doing (point-min))) +;;; (while doing +;;; (setq doing (scan-sexps doing 1)) +;;; (when doing +;;; (goto-char doing) +;;; (setq fields (cons (format "%S" (sexp-at-point)) fields)))))) +;;; (reverse fields)) +;;; ) + + +;;;Mon Jan 15 16:29:12 2001 +;;;###autoload +(defalias 'lines-line-at-point-verbatim 'lines-at-point-verbatim) + +;;;Mon Jan 15 03:02:17 2001 +;;;###autoload +(defun lines-at-point-verbatim ( ) + "Gives you just this one line at tthe current point. +this returns you the line along with the trailing \\n. Thus, if the +buffer ended up empty upon line-narrowing, this will return \"\". +If DONTNARROW is t, assume that lines has already been narrowed.. +" + (interactive) + (buffer-substring + (save-excursion + (beginning-of-line) + (point)) + (save-excursion + (forward-line 1) + (point))) + ) + +;;;Mon Jan 15 16:29:40 2001 +;;;###autoload +(defalias 'lines-line-at-point 'lines-at-point) + +;;;Mon Jan 15 03:55:05 2001 +;;;###autoload +(defun lines-at-point () + "Returns the line at this point, without the trailing \\newline. +If the buffer is empty, returns nil. +If DONTNARROW is t, assume that lines has already been narrowed.. +" + (interactive) + (let ((string (lines-at-point-verbatim ))) + (let ((len (length string))) + (if (> len 0) + (substring string 0 (- len 1)) + nil))) +) + + + + + +;;;Tue Jan 16 11:35:20 2001 +(defun lines-swap-if-necc (sym1 sym2) + "INTERNAL.. +Ensures that the value of symbol SYM1 if less than that of SYM2" + (when (> (eval sym1) (eval sym2)) + (let ((v2 (eval sym2))) + (set sym2 (eval sym1)) + (set sym1 v2))) +) + + + +;;;Tue Jan 16 15:50:31 2001 +;;;###autoload +(defun lines-narrow (&optional pt1 pt2 ) + "If called with no arguments, will assume point mark. If pt2 is +undefined, will take it to be the same as pt1. + +Will narrow buffer from the line starting pt1 to the line ending +pt2, inclusive. If pt1 is > pt2, will be swapped.. " + (interactive) + (if (null pt1) + (progn + (setq pt1 (mark)) + (setq pt2 (point)))) + (if (null pt2) + (setq pt2 pt1)) + (lines-swap-if-necc 'pt1 'pt2) + (save-excursion + (narrow-to-region + (progn + (goto-char pt1) + (beginning-of-line) + (point)) + (progn + (goto-char pt2) + (end-of-line) + (if (not (= (point-max) (point))) + (forward-char 1)) + (point)))) +) + +;;;Tue Jan 16 17:33:51 2001 +;;;###autoload +(defun lines-for-point (&optional pt) + "Line number on the point" + (interactive) + (if (null pt) (setq pt (point))) + (save-excursion + (goto-char pt) + (lines-what))) + +;;; 2002-05-14 T15:24:21-0400 (Tuesday) D. Goel +;;;###autoload +(defun lines-what-string (string) + (lines-with-string string + (lines-what))) + + + +;;; 2002-11-27 T15:21:04-0500 (Wednesday) D. Goel +;;;###autoload +(defun lines-get-fields-file (filename) + "Get fields from a file. A list per line. A list of such lists. +problem: barfs in the middle of comments..." + + (interactive "F") + (save-window-excursion + (let ((fields nil)) + (find-file filename) + (lines-narrow-initial) + (goto-char (point-min)) + (while (not (lines-last-p)) + (add-to-list 'fields (lines-get-fields)) + (next-line 1)) + (reverse fields)))) + +(defun lines-write-fields-file (fields filename) + (with-temp-file filename + (let ((left fields)) + (while left + (insert + (mapconcat + '(lambda (arg) (format "%S" arg)) + (car left) + "\t") "\n") + (pop left))))) + +(provide 'lines) + +;;;lines.el ends here.. diff --git a/elisp/erbot/contrib/mkback.el b/elisp/erbot/contrib/mkback.el new file mode 100644 index 0000000..4c93c2b --- /dev/null +++ b/elisp/erbot/contrib/mkback.el @@ -0,0 +1,601 @@ +;;; mkback.el---advanced assistance to manual archiving/backup of files. +;; Time-stamp: <2004-11-29 17:03:37 deego> +;; Copyright (C) 2002 D. Goel +;; Copyright (C) 2002 Free Software Foundation, Inc. +;; Emacs Lisp Archive entry +;; Filename: mkback.el +;; Package: mkback +;; Author: Deepak Goel <deego@gnufans.org> +;; Keywords: backup project +;; Version: 1.5dev +;; For latest version: + +(defvar mkback-home-page + "http://www.gnufans.net/~deego/emacspub/lisp-mine/fastron/") + +;; Namespace: mkback-, + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +;; uncoment this bash script, tweak if needed and save it to, say, +;; ~/bin/mkback. From then on, commands like mkback * will work +;; (interactively) from bash. + +;;; #!/bin/bash + +;;; emacs -nw -l ~/.emacs --eval="(require 'mkback)" \ +;;; --eval="(require 'mkback)" \ +;;; --eval="(mkback-from-batch $*)" + +;; (with thanks to Damian Elmes), if you prefer aliases: (untested) +;; alias mkback="emacs -batch -nw --eval=\"(progn (require 'mkback) (mkback-from-batch $*)\"" + + +(eval-when-compile (require 'cl)) + +;; Quick start: +(defvar mkback-quick-start + "See M-x mkback-introduction. + +Drop mkback.el somewhere in your load-path and add to your .emacs. +\(require 'mkback\) +\(mkback-install-for-eshell\) + + +For advanced users who use autoload mkback, simply add this to .emacs +instead of the above: +\(defvar mkback-after-load-hooks\) +\(add-hook 'mkback-after-load-hooks 'mkback-install-for-eshell\) + + +You should now have access to M-x mkback in emacs *and* in the +command-line mkback in eshell. + +Note that the mkback-install-for-eshell step is optional. Mkback will +work in eshell even without this step, but this step makes it do good +things for eshell---see commentary. + +For bash access to mkback, see the bash script above. Try the various +defcustoms to customize." ) + +;;;###autoload +(defun mkback-quick-start () + "Provides electric help regarding `mkback-quick-start'." + (interactive) + (with-electric-help + '(lambda () (insert mkback-quick-start) nil) "*doc*")) + +;;; Introduction: +;; Stuff that gets posted to gnu.emacs.sources +;; as introduction +(defvar mkback-introduction + "mkback searches for a backup/ folder in the +file's directory, or its parent directory, or the grandparent +directory , and so on. It then backs up the requested file with +a mirroring of the relative directory structure, and the +current date/time information. The file in question need not be a text +file. + +The primary functions from emacs are M-x mkback and M-x mkback-buffer. +Add (mkback-install-for-eshell), and you have an eshell-optimized +command called mkback. Finally, you can use mkback from bash by +calling emacs in batch-mode, See the included batch-script at the top +of this file. + +Only tested on GNU/Linux. Designed in a platform-independent +way--should even work on VMS. Tested with Emacs21.2 only.Type M-x +mkback-quick-start and M-x mkback-commentary for more details. +" ) + + + + + +;;;###autoload +(defun mkback-introduction () + "Provides electric help regarding `mkback-introduction'." + (interactive) + (with-electric-help + '(lambda () (insert mkback-introduction) nil) "*doc*")) + +;;; Commentary: +(defvar mkback-commentary + "Please M-x mkback-quick-start and M-x mkback-introduction first. + +Optionally, add (mkback-install-for-eshell) to .emacs. That makes +mkback do nice things--- + +* in eshell, typing mkb TAB some-file-name ENTER works. +* in eshell, typing mkb TAB ENTER works.. + +Note that this tab-completion may not work the very first time if you +follow the autoload-route to mkback-install-for-eshell. + +See the various defcustoms, hooks for customization. + + +I periodically made backups of the files I used, annotating the +backups with today's dates. Here are some design decisions: + +* The folder is called backup but customizable. + +* Sometimes, one does not want a folder to be cluttered by a huge + backup/. Consider this: project/folder1/ project/folder2/ and + project/folder3/. You often need to tar up your project/ to deliver + it to folks. Now, you don't want folders like + project/folder1/backup/ existing. + + In such a case, you would rather mkback a file like + project/folder1/file.lisp into + project/backup/folder1/file-date.lisp. + + Thus, mkback looks in current folder and in ancestors for + backup/'s. + + +* I did not want to name foo.lisp as foo.lisp-date, because that +changes extension, thus emacs etc. had a hard time recognizing the +backup-file's type. if i ever wanted to browse the backuped file. So +I preferred foo-date.lisp + +* Most of the time, I would not make more than once backup in a day, +but if I did, I could call the new one foo-date-a.lisp etc. + +* If the date is listed in yyyy-mm-dd format, then an alphabetical +directory listing is \(mostly\) also a time-ordered directory listing. +Pretty convenient. I have started naming all my dates in this +format. One can customize the date-format. + +* I am almost always in eshell when I do an archiving. So, there we go.. + + +If you are working on a patch or new feature, it is recommended that +you download the latest mkback from mkback-home-page first, and work +on that. + + +" +) + +;;;###autoload +(defun mkback-commentary () + "Provides electric help regarding `mkback-commentary'." + (interactive) + (with-electric-help + '(lambda () (insert mkback-commentary) nil) "*doc*")) + +;;; History: + +;;; Bugs: + + + + + + +;;; New features: +(defvar mkback-new-features + " + + New since 1.4 + ============================================ + + * By default, the file-modification time of the backup-ed file is + now same as that of the original file. + + * By default, The backuped file's name now stores both the + file-modification-time as well as the time at which the backup is + made. + + + +" +) + + +;;;###autoload +(defun mkback-new-features () + "Provides electric help regarding `mkback-new-features'." + (interactive) + (with-electric-help + '(lambda () (insert mkback-new-features) nil) "*doc*")) + +(defvar mkback-version "1.5dev") + +;;========================================== +;;; Code: + + +(defcustom mkback-chase-links-method 'dir + "How to chase symlinks +This can take 4 values: +'dir, 'file 'all and 'none. +'file: only chase file links, +'all: chase all links, +'none: don't chase links, +The author likes the 'dir option. ") + +(defvar mkback-before-load-hooks nil) +(defvar mkback-after-load-hooks nil) +(run-hooks 'mkback-before-load-hooks) + + +(defcustom mkback-create-new-backup-dir-p nil "") +(defcustom mkback-dir "backup" "") + +(defcustom mkback-time-format + "-%Y%m%d-%H%M-%S" + "The string to use for time-format.. More generally, any expression +that evals to a valid string.. +The current format is chosen to be windoze compatible. +The earlier format was: + -%Y-%m-%d:%H%M:%S" +) + + +(defcustom mkback-time-format-modtime + "-%Y%m%d-%H%M-%S--" + "The string to use for time-format.. More generally, any expression +that evals to a valid string.. +We get the last-modified-time of the file and use it here. ") + + +(defcustom mkback-loudness 100 + "suggested: Anywhere from 0 to 100" +) +(defcustom mkback-interactivity 100 + "Suggested: Anywhere from -100 to 100.. +if this number is too low, mkback will ask you for less and less +confirmations. +0 is the recommended value once you are familiar with mkback. " +) + +(defvar mkback-err nil "internal") +(defcustom mkback-default-get-backup-dir 'mkback-get-backup-dir + "") +(defcustom mkback-default-get-backup-path-name 'mkback-get-backup-path-name + "") +(defcustom mkback-default-get-backup-file-name 'mkback-get-backup-file-name + "") + + + +(defmacro mkback-withit (expr &rest rest) + "Caution: var-capture by its very nature.." + `(let ((it ,expr)) + ,@rest)) + +(defcustom mkback-max-depth 4 + "Is an integer.. this is the max number of ancestors to ascend to look +for an archive directory. + +A value of nil here means: no max number.. Nil is not currently +recommended as can potentially cause infinite looping if no backup/ +exists in the entire ancestory.") + + +(defcustom mkback-keep-time-p t + "When true, gives the destination file the same last-modified-time + as that of the original.") + + +;;;###autoload +(defun mkback-get-backup-dir (dir &optional suffix depth) + "An example of arguments is: +\(mkback-get-backup-dir /home/aa/bb dd\). +Then, this function looks for a backup directory in /home/aa/bb. If +it exists, then this function returns: /home/aa/bb/backup/dd. +Else this function calls +\(mkback-get-backup-dir \"/home/aa\" \"dd/bb\" \"ff\" \). + +See what i mean? If no backup/ exists here, then a backup/ exists in a +parent directory.. but then, you want to create aa/ first in that +directory when creating backup, don't you? So, this function returns +that... + +Returns nil if can't find any. +" + (unless depth (setq depth 0)) + (if (and mkback-max-depth (> depth mkback-max-depth)) + nil + (progn + ;;(unless dir (setq dir default-directory)) + (unless suffix (setq suffix "")) + (mkback-message 25 "Considering dir= %S and suffix=%S" dir suffix) + (let* ((dir-unslashed (expand-file-name "" dir)) + (dir-backup (expand-file-name mkback-dir dir)) + (dir-backup-suf (expand-file-name suffix dir-backup))) + (if + (and (file-exists-p dir-backup) + (file-directory-p dir-backup)) + dir-backup-suf + (mkback-get-backup-dir + ;; parent dir + (file-name-directory dir-unslashed) + ;; increase suffix + (mkback-withit (file-name-nondirectory dir-unslashed) + (if (equal suffix "") + it + ;; commenting this out.. should NOT use / + ;;(concat it "/" suffix) + (concat (file-name-as-directory it) suffix) + )) + (+ depth 1))))))) + + + +(defun mkback-chase-links (file) + (case mkback-chase-links-method + ('dir + (let ((dir (or + (file-name-directory file) + ;; else take the current directory... this comes in + ;; handy when calling mkback-from-batch. + default-directory ))) + ;; since we supply default-directory, + ;; this if is now mute... but let's keep it. + (if dir + (expand-file-name (file-name-nondirectory file) + (file-truename dir)) + file))) + ('file (file-chase-links file)) + ('all (file-truename file)) + (t file))) + +;;;###autoload +(defun mkback-get-backup-path-name (file &optional backup-dir + ) + "Looks around for a suitable backup/ directory nearby and returns a +suitable backup pathname. + +this is one heck of a powerful function.. + +SHOULD REALLY USE the function file-name-directory! +" + (setq file (mkback-chase-links file)) + + (let + ((initdir + (file-name-directory (expand-file-name file)))) + (unless backup-dir + (setq backup-dir (funcall mkback-default-get-backup-dir + initdir))) + (if (not backup-dir) + (if mkback-create-new-backup-dir-p + (setq backup-dir + (expand-file-name mkback-dir + initdir)) + (error "No archi(v)e directory exists here or nearby. ")))) + + (funcall mkback-default-get-backup-file-name file backup-dir)) + + + +(defun mkback-get-backup-file-name (file dir) + "File is the original file, dir is the destination directory. +This function will thus rename file with date appended, and then +append the same to the destination directory. " + (let* + ((baseinit (file-name-sans-extension + (file-name-nondirectory file))) + (extinit (file-name-extension file)) + (base + (if (string= baseinit "") + (concat "." extinit) baseinit)) + (ext2 + (if (string= baseinit "") + nil extinit)) + (raw-name-file + (concat + base + (format-time-string + (eval mkback-time-format-modtime) + (nth 5 (file-attributes file))) + (format-time-string (eval mkback-time-format)) + )) + (raw-name + (expand-file-name + raw-name-file + dir)) + (ext + (mkback-withit ext2 + (if (null it) "" + (concat "." it ))))) + (while + (file-exists-p (concat raw-name ext)) + (setq raw-name (concat raw-name "a"))) + (concat raw-name ext))) + + +(defun mkback-message (points &rest args) + (when (> (+ points mkback-loudness) 50) + (apply #'message args))) + + + +;;; 2002-05-03 T09:41:03-0400 (Friday) D. Goel +(defun mkback-no-errors (file) + (mkback-ignore-errors (mkback file))) + + +(defvar mkback-after-backup-hook nil + "Each of the functions in this hook shall take two arguments: the +full name of the original file and the ful name of the backuped +file. ") + +(defcustom mkback-gzip-p nil + "Whether to gzip the mkbacked files. More generally, any post-backup +action to perform on the backuped file. ") + +(defcustom mkback-gzip-expression + '(when + (> (nth 7 (file-attributes it)) 250) + (shell-command (format "gzip %s" it))) + "Use it for the filename here. The current expression works only on +gnulinux type systems.") + +;;;###autoload +(defun mkback (&optional file) + "Backup file/files. +With no argument, will prompt for file. If file is a list of files instead of +one file, will loop over them. + +When file is a single file, Returns nil if backup fails, returns +non-nil otherwise. + +When file is a list of files, returns the list of such results. +" + (interactive "F") + (unless file + (setq file (read-file-name "File: "))) + (unless file (error "No filaname supplied to mkback: nil")) + (if (listp file) + (mapcar #'mkback-no-errors file) + (progn + (unless (file-exists-p file) + (error "File does not exist: %S" file)) + (when (file-directory-p file) + (error "Currently, can archive only files, not directies: %S" file)) + (mkback-withit + (funcall mkback-default-get-backup-path-name file) + (let* ((dir (file-name-directory it)) + (dir-existsp (file-exists-p dir)) + (failed nil)) + (unless dir-existsp + (if (mkback-y-or-n-p 50 + (format "Create directory %S" dir)) + (make-directory dir t) + (mkback-message 99 "Not creating directory!"))) + (setq dir-existsp (and (file-exists-p dir) (file-directory-p dir))) + (setq failed (not dir-existsp)) + (unless failed + (if + (mkback-y-or-n-p 0 + (format "Copy %S to %S" (file-name-nondirectory file) + it)) + (progn + (copy-file file it nil mkback-keep-time-p)) + (setq failed t))) + (run-hook-with-args 'mkback-after-backup-hook file it) + (setq failed (not (file-exists-p it))) + (when mkback-gzip-p + (ignore-errors + (eval + mkback-gzip-expression))) + (if failed + (mkback-message 99 "File not created: %s " it) + (mkback-message 99 "Backup (now) exists:\n %s" it)) + (not failed)))))) + + + + +;;;###autoload +(defun mkback-install-for-eshell () + (interactive) + (defalias 'eshell/mkback 'mkback)) + + +(defmacro mkback-ignore-errors (&rest body) + "\(Programmer: This function should track my ignore-errors-my. \) + +Like ignore-errors, but tells the error.. +Improved for me by Kalle on 7/3/01: + * used backquote: something i was too lazy to convert my macro to.. + * removed the progn: condition-case automatically has one.. + * made sure that the return is nil.. just as it is in ignore-errors. " + `(condition-case mkback-err (progn ,@body) + (error + (ding t) + (ding t) + (ding t) + (message "IGNORED ERROR: %s" (error-message-string mkback-err)) + (sit-for 1) + nil))) + + + + +;;; 2002-05-03 T11:05:43-0400 (Friday) D. Goel +(defun mkback-y-or-n-p (add &rest args) + (if (> (+ add mkback-interactivity) 50) + (apply 'y-or-n-p args) + t)) + + +;;; 2002-05-03 T11:07:10-0400 (Friday) D. Goel +;;;###autoload +(defun mkback-buffer () + (interactive) + (mkback-withit + (buffer-file-name) + (if it (mkback it) + (mkback-message 0 "Buffer has no associated file: %S" + (buffer-name))))) + +;;; 2002-05-03 T11:10:32-0400 (Friday) D. Goel +;;;###autoload +(defun mkback-buffer-doit () + (interactive) + (let ((mkback-interactivity -100)) + (mkback-buffer))) + + +(defmacro mkback-from-batch (&rest files) + "The files get passed to emacs as symbols.. we need to simply format +them.." + `(mkback + (mkback-symbols-to-strings (quote ,files)))) + +(defun mkback-symbols-to-strings (files) + (cond + ((null files) nil) + ((listp files) (mapcar 'mkback-symbols-to-strings files)) + (t (format "%s" files)))) + + + + + +(defmacro mkback-from-batch-doit (&rest files) + "The files get passed to emacs as symbols.. we need to simply format +them.." + `(let ((mkback-interactivity -100)) + (mkback + (mkback-symbols-to-strings (quote ,files))))) + + +(defun mkback-symbols-to-strings (files) + (cond + ((null files) nil) + ((listp files) (mapcar 'mkback-symbols-to-strings files)) + (t (format "%s" files)))) + + +;; these 2 provided for historical compatibility for the next few versions.. +;; and THEY WILL BE REMOVED SOON.. +(defalias 'mkback-this-buffer 'mkback-buffer) +(defalias 'mkback-this-buffer-doit 'mkback-buffer-doit) + +(provide 'mkback) +(run-hooks 'mkback-after-load-hooks) + + + +;;; mkback.el ends here diff --git a/elisp/erbot/contrib/oct.el b/elisp/erbot/contrib/oct.el new file mode 100644 index 0000000..6247aec --- /dev/null +++ b/elisp/erbot/contrib/oct.el @@ -0,0 +1,540 @@ +;;; oct.el --- some GNU octave functions in elisp. +;; Time-stamp: <2003-06-25 12:35:50 deego> +;; Copyright (C) 2002 D. Goel +;; Emacs Lisp Archive entry +;; Filename: oct.el +;; Package: oct +;; Author: D. Goel <deego@glue.umd.edu> +;; Keywords: GNU Octave, matlab +;; Version: 0.0 +;; Author's homepage: http://deego.gnufans.org/~deego +;; For latest version: + +(defconst oct-home-page + "http://gnufans.net/~deego/emacspub/lisp-mine/oct") + + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +;; See also: + + +;; Quick start: +(defconst oct-quick-start + "Help..." +) + +(defun oct-quick-start () + "Provides electric help from variable `oct-quick-start'." + (interactive) + (with-electric-help + '(lambda () (insert oct-quick-start) nil) "*doc*")) + +;;; Introduction: +;; Stuff that gets posted to gnu.emacs.sources +;; as introduction +(defconst oct-introduction + "I love the brevity/flexibility of GNU octave. oct.el implements +\(inefficiently) a *few* common octave functions. Thus, any of the +arguments to oct-+ can be a number, a vector, or a matrix. + +For oct.el, an example of row vector is '(1 2 3), a column vector is +'((1) + (2) + (3)) + +and a matrix is +'( (1 2 3) + (2 3 4)) + +Each of oct.el's functions, oct-foo seeks to perform the exact same +behavior as that of the corrresponding octave function foo. Many are +incomplete---i.e. do not handle all possible cases of vectors/matrices +for their arguments. For documentation on any ocave function, just +(apt-get) install octave2.1*, fire up octave, and type help foo; also +look at octave info files. + +There's no matrix-multiplication here (yet). BTW, there was one +matrix.el posted here a few years ago. + +If you are not into GNU Octave, probably the only useful function here +might be some utilitiess like oct-corr (correlation) or oct-std +\(standard deviation) --- viz. just apply them to lists. + +Octav is huge, and growing. So, this library will never be complete, +nor am I working currently on it. Which is why i should go ahead and post +whatever I have here. :) " ) + +;;;###autoload +(defun oct--introduction () + "Provides electric help from variable `oct--introduction'." + (interactive) + (with-electric-help + '(lambda () (insert oct--introduction) nil) "*doc*")) + +;;; Commentary: +(defconst oct--commentary + " +matrix [1 2 3; 4 5 6; 7 8 9] should be represented as +\((1 2 3) (4 5 6) (7 8 9)) here. + +As in octave, a matrix [1] can be represented equivalently as 1, (1) +or ((1)). + +Note that we emulate octave and NOT the matlab-like 'octave +--traditional', and the two do differ in some rare aspects. " ) + + +(defun oct--commentary () + "Provides electric help from variable `oct--commentary'." + (interactive) + (with-electric-help + '(lambda () (insert oct--commentary) nil) "*doc*")) + +;;; History: + +;;; Bugs: + +;;; New features: +(defconst oct--new-features + "Help..." +) + +(defun oct--new-features () + "Provides electric help from variable `oct--new-features'." + (interactive) + (with-electric-help + '(lambda () (insert oct--new-features) nil) "*doc*")) + +;;; TO DO: +(defconst oct--todo + "Help..." +) + +(defun oct--todo () + "Provides electric help from variable `oct--todo'." + (interactive) + (with-electric-help + '(lambda () (insert oct--todo) nil) "*doc*")) + +(defconst oct-version "0.0") +(defun oct-version (&optional arg) + "Display oct's version string. +With prefix ARG, insert version string into current buffer at point." + (interactive "P") + (if arg + (insert (message "oct version %s" oct-version)) + (message "oct version %s" oct-version))) + +;;========================================== +;;; Requires: +(eval-when-compile (require 'cl)) + +;;; Code: + +(defgroup oct nil + "The group oct." + :group 'applications) +(defcustom oct-before-load-hooks nil + "Hooks to run before loading oct." + :group 'oct) +(defcustom oct-after-load-hooks nil + "Hooks to run after loading oct." + :group 'oct) +(run-hooks 'oct-before-load-hooks) + +(defcustom oct-verbosity 0 + "How verbose to be. +Once you are experienced with this lib, 0 is the recommended +value. Values between -90 to +90 are \"sane\". The +rest are for debugging." + :type 'integer + :group 'oct) +(defcustom oct-interactivity 0 + "How interactive to be. +Once you are experienced with this lib, 0 is the recommended +value. Values between -90 and +90 are \"sane\". The rest are for +debugging." + :type 'integer + :group 'oct) +(defcustom oct-y-or-n-p-function 'oct-y-or-n-p + "Function to use for interactivity-dependent `y-or-n-p'. +Format same as that of `oct-y-or-n-p'." + :type 'function + :group 'oct) +(defcustom oct-n-or-y-p-function 'oct-y-or-n-p + "Function to use for interactivity-dependent `n-or-y-p'. +Format same as that of `oct-n-or-y-p'." + :type 'function + :group 'oct) +(defun oct-message (points &rest args) + "Signal message, depending on POINTS andoct-verbosity. +ARGS are passed to `message'." + (unless (minusp (+ points oct-verbosity)) + (apply #'message args))) +(defun oct-y-or-n-p (add prompt) + "Query or assume t, based on `oct-interactivity'. +ADD is added to `oct-interactivity' to decide whether +to query using PROMPT, or just return t." + (if (minusp (+ add oct-interactivity)) + t + (funcall 'y-or-n-p prompt))) +(defun oct-n-or-y-p (add prompt) + "Query or assume t, based on `oct-interactivity'. +ADD is added to `oct-interactivity' to decide whether +to query using PROMPT, or just return t." + (if (minusp (+ add oct-interactivity)) + nil + (funcall 'y-or-n-p prompt))) + +;;; Real Code: + +(defun oct--make-matrix (element &optional n m ) + (unless m (setq m 1)) + (unless n (setq n 1)) + (setq m (round m)) + (setq n (round n)) + (cond + ((or (< m 0) (< n 0)) + (error " zeros: can't create a matrix with negative dimensions")) + ((or (= m 0) (= n 0)) + nil) + (t (make-list n + (make-list m element))))) + + +(defun oct--vectorize (element) + "Converts an elt to a list, if isn't one already" + (let* ((eltt (oct--matricize element)) + (size (oct-size eltt)) + (numrows (first size)) + (numcols (second size))) + (cond + ((= numrows 1) (first eltt)) + ((= numcols 1) (mapcar 'first eltt)) + (t (error "This is a matrix. Can't vectorize. "))))) + + +(defun oct--elementize (element) + (let* ((eltt (oct--matricize element)) + (size (oct-size eltt))) + (unless (equal size '(1 1)) + (error "not an element")) + (caar eltt))) + +(defun oct--matricize (eltt) + "will convert a vector to a Nx1 matrix. As does octave: +a(1)=1, a(2)=1, size(a). Does not check for sizes for lists." + (cond + ((numberp eltt) (list (list eltt))) + ((null eltt) '(())) + ((listp eltt) + (let ((fir (first eltt))) + (cond + ((null fir) + (if (every 'null eltt) '(()) + (error "Unequal sizes"))) + ((every 'numberp eltt) + (mapcar '(lambda (arg) (list arg)) eltt)) + ((every 'listp eltt) + eltt) + (t (error "How could i have reached here?"))))) + (t (error "shouldn't have reached here. internal oct.el error")))) + +(defun oct--minimize (elt &optional vecp) + "When rowp is true, will vectorize its stuff when possible." + (let* ((eltma (oct--matricize elt)) + (sz (oct-size eltma))) + (cond + ((equal sz '(1 1)) + (caar eltma)) + ((and vecp (= (second sz) 1)) + (mapcar + (lambda (arg) (first arg)) + eltma)) + ((and vecp (= (first sz) 1)) + (first eltma)) + (t eltma)))) + +(defun oct--equal (&rest args) + (cond + ((<= (length args) 1) t) + (t (let + ((fir (first args))) + (every 'identity + (mapcar '(lambda (arg) + (equal arg fir)) + (cdr args))))))) + +(defun oct--operator (function args default) + (cond + ((null args) default) + ((= (length args) 1) (first args)) + (t + (let* ((a (first args)) + (b (second args)) + (c (oct--matricize a)) + (d (oct--matricize b)) + (sizec (oct-size a)) + (sized (oct-size d))) + (cond + ((equal sizec '(1 1)) + (setq c (oct--make-matrix (caar c) (first sized) (second + sized)))) + ((equal sized '(1 1)) + (setq d (oct--make-matrix (caar d) (first sizec) (second + sizec)))) + (t 'noop)) + (oct--operator + function + (cons (oct--mapmatrix function c d) (cddr args)) + default))))) + +(defun oct--mapmatrix (function mat1 mat2) + "used by oct--operator" + (mapcar* + '(lambda (list1 list2) + (mapcar* function list1 list2)) + mat1 mat2)) + + + +;;;###autoload +(defun oct--remove-minus-in-string (str) + "Replace - to minus in string. +Octave can't handle filenames with - in them. " + (with-temp-buffer + (insert str) + (goto-char (point-min)) + (while (search-forward "-" nil t) + (replace-match "Minus" nil t)) + (buffer-substring-no-properties (point-min) (point-max)))) + +;;;==================================================== + +(defun oct-zeros (&optional n m) + (oct--make-matrix 0 n m)) +(defun oct-ones (&optional n m) + (oct--make-matrix 1 n m)) + + +(defun oct-sum (x &optional n) + " +if n = 1, sum along columns. 1 is the default. +if n = 2, sum along rows. + +If no n provided, and x happens to be a vector along any dimension, +perform the sum in any case. " + (oct--minimize + (let* + ((xx (oct--matricize x)) + (size (oct-size xx)) + (nrows (first size)) + (ncols (second size))) + (when (null n) + (cond + ((= nrows 1) (setq n 2)) + (t (setq n 1)))) + (cond + ((= n 1) + (list + (apply + 'mapcar* + (lambda (&rest elements) + (apply '+ elements)) + xx))) + ((= n 2) + (mapcar + '(lambda (list) + (list (apply '+ list))) + xx)) + (t (error "Improper second argument to oct-sum. ")))))) + + + +(defun oct-size (a &optional n) + "When given N, returns row dimension if N = 1, else column +dimension. " + (cond + ((equal n 1) + (first (oct-size a ))) + ((equal n 2) + (second (oct-size a))) + (t + (let* + ((b (oct--matricize a)) + (sizes (mapcar 'length b)) + (numcolumns (first sizes))) + (unless + (oct--equal numcolumns) (error "unequal sizes")) + (list (length sizes) numcolumns))))) + +(defun oct-rows (a) + (oct-size a 1)) +(defun oct-columns (a) + (oct-size a 2)) + +(defun oct-length (a) + (apply 'max (oct-size a))) + + +(defun oct-.* (&rest args) + (oct--operator '* args 1)) + +(defun oct-/ (x n) + "not general enough yet. n can only be a number. +moreover, converts everything to float." + (oct--operator + (lambda (a b) + (/ (float a) b)) + (list x n) + 1)) + +(defun oct-+ (&rest args) + (oct--operator '+ args 0)) +(defalias 'oct-add 'oct-+) + +(defun oct-- (&rest args) + (oct--operator + '- + (if (= (length args) 1) + (cons 0 args) + args) + 0)) +(defalias 'oct-subtract 'oct--) +(defalias 'oct-sub 'oct--) + + + + + +(defun oct-corr (x y) + "This does need 2 matrices as of right now. + + +In fact, currently, just takes a list x and a list y and returns the +corr coeff. + +When implemented, will be Just like octave: +If X is has dimensions M and Nx, and Y has dimensions M and Ny, +then the returned matrix Z has dimensions Nx and Ny. +And Z(Nx, Ny) = corr bet. X(:,Nx) and between Y(:,Ny). " + + (let* + ((xa (oct--vectorize x)) + (ya (oct--vectorize y)) + (n (oct-length xa)) + (nn (float n)) + (sumxy (oct--elementize (oct-sum (oct-.* xa ya)))) + (sumxx (oct--elementize (oct-sum (oct-.* xa xa)))) + (sumyy (oct--elementize (oct-sum (oct-.* ya ya)))) + (sumx (oct--elementize (oct-sum xa))) + (sumy (oct--elementize (oct-sum ya)))) + (/ (- sumxy (/ (* sumy sumx) nn)) + (sqrt + (* (- sumxx (/ (* sumx sumx) nn)) + (- sumyy (/ (* sumy sumy) nn))))))) + + +(defun oct-complement (x) + "is like the ' in octave" + (let ((xx (oct--matricize x)) + (yy nil)) + (while (caar xx) + (push + (mapcar 'first xx) yy) + (setq xx (mapcar 'cdr xx))) + (reverse yy))) + + +(defun oct-sumsq (x) + "Works only for vectors right now." + (let ((xv (oct--matricize x))) + (oct--elementize (oct-sum (oct-.* xv xv))))) + + +(defun oct-mean (x) + " +no second argument yet. works only for vectors." + (let ((xv (oct--vectorize x))) + (oct--minimize + (oct-/ (oct-sum x) (oct-length x))))) + + +(defun oct-sqrt (x) + "only numbers as of now." + (let ((xe (oct--elementize x))) + (sqrt xe))) + +(defun oct-std (x) + (let* ((xv (oct--vectorize x)) + (mean (oct-mean xv)) + (nm1 (- (oct-length xv) 1))) + (sqrt + (/ (float (oct-sumsq (oct-- xv mean))) + nm1)))) + + +(defun oct-tanh (x) + (cond + ((listp x) + (mapcar 'oct-tanh x)) + ((> 1 x) + (/ + (float (- 1 (exp (* -2 x)))) + (float (+ 1 (exp (* -2 x)))))) + (t + (/ + (float (- (exp (* 2 x)) 1)) + (float (+ (exp (* 2 x)) 1)))))) + + +(defun oct-atanh (x) + (cond + ((listp x) + (mapcar 'oct-atanh x)) + (t + (* 0.5 + (log (/ (float (+ 1 x)) + (- 1 x))))))) + + + +(defun oct-colon (x y) + (if (<= x y) + (cons x (oct-colon (+ x 1) y)) + nil)) + +(defun oct-sign (x) + (if (listp x) + (mapcar 'oct-sign x) + (cond + ((> x 0) 1) + ((< x 0) -1) + (t 0)))) + + + +(provide 'oct) +(run-hooks 'oct-after-load-hooks) + + + +;;; oct.el ends here diff --git a/elisp/erbot/contrib/shs.el b/elisp/erbot/contrib/shs.el new file mode 100644 index 0000000..b2b3311 --- /dev/null +++ b/elisp/erbot/contrib/shs.el @@ -0,0 +1,552 @@ +;;; shs.el --- facilitate SHell Scripting through Emacs. +;; Time-stamp: <2006-05-08 00:00:17 deego> +;; Copyright (C) 2005 D. Goel +;; Emacs Lisp Archive entry +;; Filename: shs.el +;; Package: shs +;; Author: D. Goel <deego@gnufans.org> +;; Keywords: +;; Version: 0.0 +;; URL: http://gnufans.net/~deego +;; For latest version: + +(defconst shs-home-page + "http://gnufans.net/~deego/emacspub/lisp-mine/shs/") + +;; Copyright (C) 2005 D. Goel + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + + + +;; sh.el, posted here a few days ago has been renamed to shs.el since +;; there exists another sh.el -- shs stands for SHell-Script. + +;; SHS: Shs aims to facilitate free mixing of elisp with bash: free +;; calls to elisp code from bash shell scripts and calls to other bash +;; scripts from that elisp code, which may again call elisp code and +;; so on, all the while doing the right things as regards bash's error +;; codes, stderr, stdout, etc. + +;; Moreover, one shouldn't need to exit emacs just to pipe one emacs +;; script's call to another. + +;; Finally, elisp code should also be able to run independently of +;; bash in running emacsen. + +;; Provides basic setup for emacs scripting. To the beginning of all +;; emacs shell-scripts, don't forget to add (add-to-list 'load-path +;; directory) and (require 'shs). Use shs as a convenient way to call +;; shell-commands from the script. Provides a tutorial on elisp-based +;; shell-scripting. + + +(eval-when-compile (require 'cl)) + + +;; The most common functions to use are: shs-process (shsp), shs-shell +;; (shsh). + +;; Alt, using shell command: shsh. +;; Best way to show messages: shs-message. + +;; Your code should automatically run fine, both in shellscripts as +;; well as emacs: + + +;; The easiest way to pass messages would be to (message) or +;; (princ). However, that makes it somewhat meaningless in running +;; emacs, so prefer using (shs-message) instead. When using +;; shs-message in running Emacs, all these messages go to *SHS* +;; buffer, which you'll finally want to switch to and see. + + + +;; See also: + + +;; Quick start: +(defconst shs-quick-start + "Help..." +) + +(defun shs-quick-start () + "Provides electric help from variable `shs-quick-start'." + (interactive) + (with-electric-help + '(lambda () (insert shs-quick-start) nil) "*doc*")) + +;;; Introduction: +;; Stuff that gets posted to gnu.emacs.sources +;; as introduction +(defconst shs-introduction + " \(sh.el, posted here a few days ago has been renamed to shs.el +since there exists another sh.el). + +shs stands for SHell-Scripting. + +I am an utter novice at shell scripting, so suggestions and comments +are most welcome, and please forgive any mistakes in shs. shs aims to +facilitate free mixing of elisp with bash: free calls to elisp code +from bash shell scripts and calls to other bash scripts from that +elisp code, which may again call elisp code and so on, all the while +doing the right things as regards bash's error codes, stderr, stdout, +etc. + +Moreover, one shouldn't need to exit emacs just to pipe one emacs +script's call to another. + +Finally, ideally, that elisp code should also be able to run +independently of bash in running emacsen. All that's what shs hopes +to faciliatate. + + +INSTALLATION: Just add shs.el somewhere in your emacs' load-path. + + +For a shell scripting example, (you do need EmacsCVS) + + +Drop shs.el and the two attached files to a ~/location that is present +both in your emacs' loadpath as well as bash's PATH. Create a +~/.emacs.script with these contents: + + (add-to-list 'load-path \"~/location\") + +To be able to use your settings in running emacsen too, also add to +the end of ~/.emacs: (load \"~/.emacs.script\") + +Then, from bash, run shs-example, for a tutorial (I am still learning) +on shell-scripting through Emacs. + +Whenever you call shsp instead of shsh, COMMAND is no longer a +string. It is rather a list whose 1st value is the process, and the +rest of the values are the args. + +For script examples to work, you do need emacscvs installed in (or +linked to from) /usr/local/bin/emacscvs. + +" +) + +;;;###autoload +(defun shs-introduction () + "Provides electric help from variable `shs-introduction'." + (interactive) + (with-electric-help + '(lambda () (insert shs-introduction) nil) "*doc*")) + +;;; New features: +(defconst shs-new-features + "Help..." +) + +(defun shs-new-features () + "Provides electric help from variable `shs-new-features'." + (interactive) + (with-electric-help + '(lambda () (insert shs-new-features) nil) "*doc*")) + +(defconst shs-version "0.0") + +;; Real Code + + +;; Always make your function +(defmacro shs-exit-code-1 (&rest body) + "Normally, if the script errors somewhere, Emacs will immediately +exit with an error code of 255, which is the right thing to do. If +for some reason, you want a different error code, you can wrap this +macro around your lisp code." + (let ((err (gensym))) + `(condition-case ,err (progn ,@body) + (error + (shsm "Error: %S" (error-message-string ,err)) + (kill-emacs 1))))) + + + + +(defun shs-sanitize (str) + "Delete up to one trailing newline from the string. +Typically, shs.el feeds shell commands' output to this function, so +that the result does not have a trailing newline. Is like perl's chop, + except that this is applied automatically in shs" + + (replace-regexp-in-string + "\n\\'" "" (format "%s" str))) + +(defalias 'shs-chop 'shs-sanitize) + + + +(defalias 'shs-shell-exit 'shs-shell-command-with-exit) + +(defvar shs-shell-buffer "*SHS-SHELL*") +(defvar shs-process-buffer "*SHS-PROC*") +(get-buffer-create shs-shell-buffer) +(get-buffer-create shs-process-buffer) + +;;;###autoload +(defun shs-shell-command (command &rest args) + "Shell commands from a running script, exit on errors. + +NOT suitable for asynchronous shell commands. If everything ok, +then return the result of the shell-command as a string, else +exit emacs with the same exit code. + +COMMAND shou]d be a string. You can also give us the command in +the shsp format: a list. In that case, we shall try to guess the +command by converting it to a string by concatting the +shell-quote-argument for each argument. But note that shsp might +be safer. +" + (shsh--reset-buffer) + (setq command (shs-convert-command-list-to-string-maybe command)) + (let ((code (apply 'shell-command command shs-shell-buffer nil)) + (output + (with-current-buffer shs-shell-buffer + (shs-sanitize + (buffer-substring (point-min) (point-max)))))) + + (cond + ((equal code 0) + output) + ;; as you see, the string-to-number of this error code will + ;; always be the correct error code. + (t (error "%S -- error code when trying %S\n Output was: %S" code + command output))))) + +(defun shs-convert-command-list-to-string-maybe (c) + (if (stringp c) + c + (shs-convert-command-list-to-string c))) + +(defun shs-convert-command-list-to-string (c) + (mapconcat 'shell-quote-argument + c " ")) + + +(defun shs-convert-command-string-to-list-maybe (c) + (if (listp c) + c + (shs-convert-command-string-to-list c))) + +(defun shs-convert-command-string-to-list (c) + (split-string c)) + + +;;;###autoload +(defun shs-shell-command-and-code (command &rest args) + (shsh--reset-buffer) + (let ((code (apply 'shell-command command shs-shell-buffer nil))) + (list code + (with-current-buffer shs-shell-buffer + (shs-sanitize + (buffer-substring (point-min) (point-max))))))) + + + + +(defun shsp--reset-buffer () + (with-current-buffer shs-process-buffer + (delete-region (point-min) (point-max)))) + +(defun shsh--reset-buffer () + (with-current-buffer shs-shell-buffer + (delete-region (point-min) (point-max)))) + +;;;###autoload +(defun shs-process-and-code (command &optional infile) + (shsp--reset-buffer) + (let ((code (apply 'call-process (car command) infile shs-process-buffer + nil (cdr command)))) + (list code + (with-current-buffer shs-process-buffer + (shs-sanitize + (buffer-substring (point-min) (point-max))))))) + +;;;###autoload +(defun shs-process (command &optional infile instring outfile appendp) + "process from a running script, exit on errors. + +NOT suitable for asynchronous processes. If everything ok, +then return the result of the shell-command as a string, else +error with the same exit code. + +COMMAND shou]d be a list. You can also give us the command in +the shsh format: a string. In that case, we shall convert it to +a list by taking every word in that string. But note that list +might be safer. + +Both infile and instring can be nil, in which case, no stdin is passed +to the process. + +If INFILE is non-nil it is used. If INFILE is nil and INSTRING is +not, we put instring in a temporary file, and use that as the +stdin. This is kinda like bash's <. + +If outfile is non-nil, the output is also written to outfile. If +appendp is non-nil, the output is appended to any preceding output. +These were kinda like bash's > and >>. + +pseudo-Pipes can be accomplished via use of instring. See, for +example, `shsu-pipe'. +" + (let ((rmp (and (not infile) instring))) + (setq command (shs-convert-command-string-to-list-maybe command)) + (when rmp + ;; see also, for example, shsu-mktemp-d + (setq infile (shsp "mktemp")) + (with-temp-buffer + (insert instring) + (let ((require-final-newline nil)) + (write-file infile nil)))) + (let* ((codeoutput (shs-process-and-code command infile)) + (code (car codeoutput)) + (output (cadr codeoutput))) + (when rmp (delete-file infile)) + (cond + ((equal code 0) + (when outfile + (with-temp-buffer + (when (and appendp (file-exists-p outfile)) + (insert-file-contents outfile)) + (goto-char (point-max)) + (insert output) + (let ((require-final-newline nil)) + (write-file outfile nil)))) + output) + ;; as you see, the string-to-number of this error code will + ;; always be the correct error code. + (t (error "%S -- error code when call-process: %S\n Output was: %S" code command output)))))) + + + + + +(defmacro shs-ignore-errors-flag (&rest body) + "Copied from ignore-errrors-my. + +which: Like ignore-errors, but tells the error.. +Improved for me by Kalle on 7/3/01: + * used backquote: something i was too lazy to convert my macro to.. + * removed the progn: condition-case automatically has one.. + * made sure that the return is nil.. just as it is in ignore-errors. " + (let ((err (gensym))) + `(condition-case ,err (progn ,@body) + (error + (ding t) + (ding t) + (ding t) + (shsm "IGNORED ERROR: %s" (error-message-string ,err)) + (sit-for 1) + nil)))) + + + + + + + + +;;;###autoload +(defalias 'shs-shell 'shs-shell-command) + + +;;;###autoload +(defalias 'shsh 'shs-shell-command) + + +;;;###autoload +(defalias 'shsp 'shs-process) + +;;;###autoload +(defalias 'shs-call-procell 'shs-process) + +(defun shs-shell-command-with-error (&rest args) + "NOT USED ANY MORE. +Shell commands from a running script, exit on errors. + +NOT suitable for asynchronous shell commands. If everything ok, +then return the result of the shell-command as a string, else +exit emacs with the same exit code. +" + (let ((code (apply 'shell-command args))) + (cond + ((equal code 0) + (with-current-buffer shs-shell-buffer + ;;(buffer-substring-no-properties (point-min) (point-max)))) + (shs-sanitize + (buffer-substring (point-min) (point-max))))) + (t (error (format "Bash Error code: %S" code)))))) + + + +(defvar shs-buffer "*SHS*") +(get-buffer-create shs-buffer) + +(defvar shs-message-sit-for 0.1 + "We wait for this duration at critical points when using shs. +Matters only when called within emacs. ") + +(defun shs-message (&rest args) + (cond + (noninteractive + (apply 'message args)) + (t + (save-excursion + (set-buffer (get-buffer-create shs-buffer)) + (goto-char (point-max)) + (insert "\n") + (insert (apply 'format args)) + (message + "%s" + (apply 'format args) + + ;;"Note: This message is saved in the *SHS* and *messages* + ;;buffer." + ) + (sit-for shs-message-sit-for))))) + + + +(defalias 'shs-msg 'shs-message) +(defalias 'shsm 'shs-message) + + +;; OBSOLETE +(defalias 'shs-shell-error 'shs-shell-command-with-error) + + +(defun shs-display-buffer () + (display-buffer shs-buffer) + (let ((cur (current-buffer))) + (set-buffer shs-buffer) + (goto-char (point-max)) + (set-buffer cur))) + + +(defvar shs-bye-hook (list 'shs-display-buffer)) + +(defun shs-bye () + (interactive) + (run-hooks 'shs-bye-hook) + ) + +(defun shs-clear-buffer () + (interactive) + (save-excursion + (set-buffer (get-buffer-create shs-buffer)) + (erase-buffer))) + +(defvar shs-start-hook (list 'shs-clear-buffer)) +(defun shs-start () + "For use when using shs from eshell. " + (interactive) + (run-hooks 'shs-start-hook)) + +(defvar shs-within-p nil + "When non-nil, start and end-hooks are NOT executed.. May be useful +to set via the `shs-within' macro one \"top-level\" shs function is +calling another.. + +In the default setting, this matters only when shs functions are used +from within emacs") + +(defmacro shs-within (&rest args) + `(let ((shs-within-p t)) + (progn ,@args))) + + +(defun shs-help (g) + "Call this function with your function name." + (shsm "") + (shsm + "Running this script calls the Emacs function described below.") + (shsm + (let* ((def (symbol-function g))) + (ignore-errors + (if (equal 'autoload (car-safe def)) + (load (second def)))) + ;; this check does nothing now.. need ro + + (describe-function g)))) + + + +(defun shs-help-check (args) + (let + ((argstr + (mapconcat + (lambda (a) (format "%s" a)) + args + " "))) + (or + (string-match "\\b-h\\b" argstr) + (string-match "help" argstr)))) + + +(defun shs-shell-flag (command &rest args) + " +Added back, since used by some of my scripts. " + (let ((coderes (apply 'shs-shell-command-and-code command args))) + (when (not (equal (first coderes) 0)) + (shsm "IGNORED: ERROR CODE: %S WHEN TRYING %S " (first coderes) + command)) + (second coderes))) + + +;;;###autoload +(defun shs-expand-file-name (file dired) + "Copied from utils-expand-file-name. + +Suggested by Paul Jarc on g.e.d. in 2005-07 when I raised this +issue: + +Emacs' default expand-file-name is slightly borked, the bork can be +seen if there is a file or a directory literally named ~. The bork +comes from the emacs-tilde-feature: anywhere emacs sees a ~ in a +path, it drops the entire preceding path and starts from /home/$USER +afresh. + +viz. Create a file ~/tmp/~. Then + \(expand-file-name (file-name-nondirectory \"~/tmp/~\") + \(file-name-directory \"~/tmp/~\")) +is incorrect + +The version below avoids that problem, but of course, it lacks +the emacs-tilde-feature. It is also portable across platforms, +including VMS. + +However, note that this function is not necc. conformant with expand-file-name +as far as argument structure and all function features are concerned. +" + (concat (file-name-as-directory dired) + (file-name-nondirectory file))) + + + + + + +(provide 'shs) + + diff --git a/elisp/erbot/contrib/soap.el b/elisp/erbot/contrib/soap.el new file mode 100644 index 0000000..a372526 --- /dev/null +++ b/elisp/erbot/contrib/soap.el @@ -0,0 +1,66 @@ + + +;;; soap.el --- Simple Object Access Protocol support for Emacs + +;; Copyright (C) 2002 Edward O'Connor <ted@oconnor.cx> + +;; Author: Edward O'Connor <ted@oconnor.cx> +;; Keywords: comm, tools, processes +;; Version: 0.1 + +;; This file is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 3, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public +;; License along with GNU Emacs; see the file COPYING. If not, +;; write to the Free Software Foundation, Inc., 59 Temple Place - +;; Suite 330, Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This is the barest of beginnings of SOAP support for Emacs. It +;; really doesn't do much of anything; to see how to use it, see +;; google.el. Someone who cares about SOAP should probably make +;; this into an actual SOAP implementation. + +;;; Code: + +(require 'url) + +(defun soap-process-response (response-buffer) + "Process the SOAP response in RESPONSE-BUFFER." + (let ((retval nil)) + (with-current-buffer response-buffer + (goto-char (point-min)) + (when (looking-at "^HTTP/1.* 200 OK$") + (re-search-forward "^$" nil t 1) + (setq retval (buffer-substring-no-properties (point) (point-max)))) + (kill-buffer response-buffer)) + (with-temp-buffer + (insert "\n" retval "\n") + (goto-char (point-min)) + (while (re-search-forward "\r" nil t) + (replace-match "")) + (xml-parse-region (point-min) (point-max))))) + +(defun soap-request (url data) + "Send and process SOAP request to URL with DATA." + (let* ((url-request-extra-headers + `(("Content-type" . "text/xml; charset=\"utf-8\"") + ("SOAPAction" . ,(format "%S" url)))) + (url-request-method "POST") + (url-request-data + (concat "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n" + data))) + (soap-process-response (url-retrieve-synchronously url)))) + +(provide 'soap) +;;; soap.el ends here + diff --git a/elisp/erbot/contrib/timerfunctions.el b/elisp/erbot/contrib/timerfunctions.el new file mode 100644 index 0000000..8d68f06 --- /dev/null +++ b/elisp/erbot/contrib/timerfunctions.el @@ -0,0 +1,431 @@ +;;; timerfunctions.el---enhanced versions of some timer.el functions. +;; Time-stamp: <2003-05-09 08:23:24 deego> +;; Copyright (C) Deepak Goel 2000, 2001, 2002 +;; Emacs Lisp Archive entry +;; Filename: timerfunctions.el +;; Author: Deepak Goel <deego@gnufans.org> +;; Version: 1.4.2 +;; Created: 2000/11/20 + +;; Author's homepage: http://gnufans.net/~deego +;; For latest version: + +(defconst timerfunctions-home-page + "http://gnufans.net/~deego/emacspub/timerfunctions") + + + +(defvar timerfunctions-version "1.4.2") + + +;;;======================================================== +;;;======================================================== +;;; Commentary: The latest version can always be downloaded from +;;; http://www.glue.umd.edu/~deego/emacs.html + + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + + +;;; See also: midnight.el (part of emacs), timer.el + + + + +;;; New features: +(defconst timerfunctions-new-features + "New since last posting: Changed the syntax of `tf-with-timeout' and +provided a `tf-with-timeout-check'.") + +(defun timerfunctions-new-features () + "Provides electric help from variable `timerfunctions-new-features'." + (interactive) + (with-electric-help + '(lambda () (insert timerfunctions-new-features) nil) "*doc*")) + + +(defconst timerfunctions-introduction + "timerfunctions.el contains some 'enhanced' versions of a few timer.el +functions. It is also used by vel.el, idledo.el etc. + + Suppose you want emacs to run an action every REDOSECS for + _as_long_as emacs remains idle. `tf-run-with-idle-timer' allows that. + + `tf-with-timeout' is a generalized with-timeout where you can inhibit + breaks within parts of the body that you want. + + QUICKSTART: + Place this file somewhere in yr emacs-load-path, and add the + foll. to your .emacs: (load \"timerfunctions.el\") +" +) + +;;;###autoload +(defun timerfunctions-introduction () + "Provides electric help from variable `timerfunctions-introduction'." + (interactive) + (with-electric-help + '(lambda () (insert timerfunctions-introduction) nil) "*doc*")) + +;;; Real Code: + + +;;;###autoload +(defun tf-time-difference (timeplus timesub) + "Gives the time in seconds elaspsed from TIMESUB to TIMEPLUS. +Almost like \(- TIMEPLUS TIMESUB \)." + (+ (* (expt 2 16) (- (car timeplus) (car timesub))) + (- (cadr timeplus) (cadr timesub))) +) + + +;;;###autoload +(defun tf-run-with-idle-timer (secs repeat redosecs redorepeat includeruntime function &rest args) + "Args are SECS, REPEAT, REDOSECS, REDOREPEAT, INCLUDERUNTIME, +FUNCTION and &rest ARGS. +Similar to run-with-idle-timer, except that provides more options. +Suppose you want emacs to run an action every REDOSECS for as long as +emacs remains idle. Think you can do it with the emacs' +run-with-idle-timer? Think again.. :) That function will perform the +action exactly once every time emacs goes idle. This funciton, +tf-run-with-idle-timer *will* allow you to keep performing an action +as long as emacs remains idle. + +SECS is the number of seconds to wait once emacs has first gone +idle. It can really be any expression whose at runtime yields a +number.. Note that the way run-with-idle-timer is defined, SECS will +unfortunately be evalled immediately after you call this function, but +redosecs will be *every* time emacs *remains* idle..yay.. + + +If REDOREPEAT is non-nil, the action is repeated as long emacs remains +idle. REDOSECS is the number of additional seconds (after the action +has been done) to wait if emacs remains idle before performing the +action again. Again, redosecs does not have to be a number, it can be +any expression whose eval yields to a number... + +If INCLUDERUNTIME is non-nil, REDOSECS is the number of +additional seconds to wait after the action has been invoked (not +finished). + +If REPEAT is nonnil, the entire cycle is repeated every time emacs +next goes idle.. (as in the default run-with-idle-timer." + (apply 'run-with-idle-timer + (eval secs) repeat 'tf-run-while-idle + redosecs redorepeat includeruntime + function args) + ) + + +(defun tf-run-while-idle (redosecs redorepeat includeruntime +function &rest args) + "Runs FUNCTION with ARGS and optionally repeats if emacs idle. +Probably is of no use unless used in programs. + If REDOREPEAT is non-nil, the function is repeated periodically every +REDOSECS as long as emacs remains idle. By default, emacs waits +REDOSECS *after* the function is done executing to repeat. If you want +the execution-time to count towards REDOSECS, make INCLUDERUNTIME +non-nil. +SECS and REDOSECS can be any expressions that eval at runtime to +numbers.. In particular, they can simply be numbers.. + +" + (if (not includeruntime) + (progn + (apply function args) + (if redorepeat + (while (sit-for (eval redosecs)) + (apply function args)))) + (progn + (let ((before-time (current-time))) + (apply function args) + (if redorepeat + (while (sit-for (- + (eval redosecs) + (tf-time-difference (current-time) + before-time))) + (setq before-time (current-time)) + (apply function args)))))) + ) + + +;;;==================================================== +;;;TESTS FOLLOW +(defun tf-test-display-time-internal + () + (let ((thisbuffer (buffer-name))) + (switch-to-buffer-other-window "*scratch*") + (goto-char (point-max)) + (insert (concat "\n" (format "%S" (cadr (current-time))))) + (recenter) + (switch-to-buffer-other-window thisbuffer)) +) + + +(defun tf-test-idle-timer () + "Run this and watch..Play around with the options.. If you run it, +you may have to exit your emacs session to restore normal emacs! +unless you are an expert, that is.." + + (interactive) + (tf-run-with-idle-timer + 1 t 3 t nil 'tf-test-display-time-internal) +) + + + + + +(defun tf-test-timeout () + "Bad count should be zero. " + (interactive) + (let ((inhi nil) (goodcount 0) (badcount 0) (ctr 0) (a 1) (b 2) + (mytag nil) + (myvar nil) + ) + (loop + for ctr from 0 to 10 do + (message "ctr=%S" ctr) + (tf-with-timeout 'inhi 'mytah 'myvar + (0.3 nil) + (loop for i from 0 to 100000 do + (message "ctr=%S, i=%S" ctr i) + (setq inhi t) + (setq a (random 100)) + (sleep-for 0.1) + (setq b a) + (setq inhi nil) + (sleep-for 0.02) + )) + (if (equal b a) (incf goodcount) (incf badcount))) + (message "Goodcount: %S; badcount: %S" goodcount badcount))) + + + +(defun tf-test-timeout-complex () + "Should return a value of 20000 for a. " + + (interactive) + (let ((inhi t) (goodcount 0) (badcount 0) (ctr 0) (a 1) (b 2) + (mytag nil) + (myvar nil) + ) + (setq a 0) + (message "ctr=%S" ctr) + (tf-with-timeout + 'inhi 'mytag 'myvar + (0.1 nil) + (loop for i from 0 to 10000 do + (message "first loop. i=%S" ctr i) + (incf a)) + (message "initial loop ends here.") + ;; no throw here because loop prohibited. + (tf-with-timeout-check 'inhi 'mytag 'myvar) + ;; this shouldn't help either + (sit-for 0.3) + + (loop for i from 0 to 10000 do + (message "second loop. i=%S" i) + (incf a)) + (message "second loop ends here.") + (setq inhi nil) + ;; this should throw. + (tf-with-timeout-check 'inhi 'mytag 'myvar) + ;; this should NOT be needed. + ;;(sit-for 0.2) + ;; this loop should never take place. + (loop for i from 0 to 1000 do + (message "third loop, i=%S" i) + (incf a)) + (message "third loop ends here.")) + (message "%S" a) + a)) + + +(defun tf-wait-until-idle (&optional secs) + "DOES NOT WORK YET. Waits until idle. +Will help run processes in background. This function will NOT create +a timer. Will simply use sit-for. " + (if (null secs) + (setq secs 1)) + (while (not (sit-for secs)) + (sit-for 1)) + (message "tf-wait-until-idle DONE WAITING!") +) + + +;;;Tue Jan 23 17:38:44 2001 +(defmacro tf-ignore-errors (&rest body) + "Like ignore-errors, but tells the error.." + (let ((err (gensym))) + (list 'condition-case err (cons 'progn body) + (list 'error + (list 'message + (list 'concat + "IGNORED ERROR: " + (list 'error-message-string err))))) + )) + + + + +(defvar tf-with-timeout-repeat-sec 0.01 + "If the initial timeout fails because of inhibitedness, we shall +check every this many seconds to see if we are uninhibited. This +variable is customizable. ") + + +(defun tf-with-timeout-handler-internal (tag timedoutvar inhibitp) + (set timedoutvar t) + ;;(tf-with-timeout-check tag timedoutvar inhibitp) + ;; which is equivalent to: + (unless (eval inhibitp) + (tf-ignore-errors (throw tag 'timeout))) + ) + +(defun tf-with-timeout-check (inhibitp tag timedoutvar) + ;; check whether timeout has actually reached. + ;; we need this step because this function might be called by the + ;; user as well. + (when (eval timedoutvar) + (unless (eval inhibitp) + (tf-ignore-errors (throw tag 'timeout))))) + + + +(defvar tf-tag-tmpvar nil) + +(defmacro tf-catch (tag &rest body) + `(let + ;; unquote the tag here.. + ((,(cadr tag) 'tf-catch)) + (catch ,tag + ,@body))) + +(defmacro tf-throw (tag value) + `(when (eql (eval ,tag) 'tf-catch) + (throw ,tag value))) + + +;;;###autoload +(defmacro tf-with-timeout (inhibitp timertag timedoutvar tlist &rest body) + "Like `with-timeout' but provide ability to inhibit timeout during +parts of the body. Note that most of the time, you may not need this +functionality at all unless you want to be very 'clean' about +things---you could get by with the regular with-timeout and not using +sit-for's in the body. Or with the regular with-timeout and using +unwind-protect. + + +TO DECIDE: IN VIEW OF THE UNWIND-PROTECT, DO WE NEED THIS FUNCTION AT ALL?? + +Run BODY, but if it doesn't finish in SECONDS seconds, give up. +If we give up, we run the TIMEOUT-FORMS which are contained in TLIST +and return the value of the last one. +The call should look like: + (tf-with-timeout quoted-expr (SECONDS TIMEOUT-FORMS...) BODY...) + +The timeout is checked whenever Emacs waits for some kind of external +event \(such as keyboard input, input from subprocesses, or a certain time); +if the program loops without waiting in any way, the timeout will not +be detected. Furthermore: + +During the execution of the body, we SHALL NOT time out when INHIBITP +evals to non-nil. Thus, for example, you might initially setq a +variable my-var as nil, supply inhibitp as 'my-var, and then you may +setq my-var to t or nil within the body of tf-with-timeout to enable +or disable timeout. The best use of this functionality is to setq +inhibitp to t when during parts of loops where you do not want the +body broken within certain parts of the loop. (Of course, if that +part of the loop does not contain any sit-for's or read's then you +don't have to worry about this in the first place..) + + +again, Do not forget my-var to some value before attempting to use this +tf-with-timeout :) + +Here's an example: + + + (let ((myinhibit t)) + (tf-with-timeout 'myinhibit 'mytag 'mytimedoutvar + (2 2) + (setq a nil) + (setq b nil) + (sit-for 4) + (setq a 4) + (setq myinhibit nil) + (sit-for 2) + (setq b 5) + )) + + +The above example requests a timeout within 2 seconds. However, the +timeout can takes place only when myinhibit is set to nil, +which becomes true after about 4 seconds. Thus, after the execution of the +body, a has the value 4, but b has the value nil. + +See `tf-test-timeout' for another example. + +Important Note: If the body of a loop tends to stay in a timeout +inhibited region for most of the time, then make sure that the timeout +enabled region atleast spans about 0.02 seconds.. thus, use (sleep-for +0.02) if needed.. this is because we check every 0.01 seconds if an +uninhibited timeout condition has been satisfied. + +But perhaps you do not want to include (sleep-for 0.02) because that +wastes precious cpu time. Simple, don't include it, just after a long +inhibited body, you can include a timeout check within the body +instead of (sleep-for 0.02): + (tf-with-timeout-check 'mytag 'mytimedoutvar 'myinhibitp) + +Moreover, if that is the main check you rely on, you it perhaps makes +sense to increase the value of tf-with-timeout-repeat-sec, so that +your cpu cycles are not wasted every 0.01 sec. See the doc of that +variable for more. + +Timertag should be a quoted symbol, also we WILL set that symbol to t +during the execution of these forms. + +" + (let ((seconds (car tlist)) + (timeout-forms (cdr tlist))) + `(let ( + ;;(with-timeout-tag (cons nil nil)) + with-timeout-value with-timeout-timer) + (set ,timedoutvar nil) + (if (catch ,timertag + (progn + (setq with-timeout-timer + (run-with-timer ,seconds tf-with-timeout-repeat-sec + 'tf-with-timeout-handler-internal + ,timertag ,timedoutvar + ,inhibitp)) + (setq with-timeout-value (progn ,@body)) + nil)) + (progn ,@timeout-forms) + (cancel-timer with-timeout-timer) + with-timeout-value)))) + + +(provide 'timerfunctions) + +;;;timerfunctions.el ends here. + diff --git a/elisp/erbot/contrib/translate.el b/elisp/erbot/contrib/translate.el new file mode 100644 index 0000000..f60d9ea --- /dev/null +++ b/elisp/erbot/contrib/translate.el @@ -0,0 +1,237 @@ +;; Emacs Lisp Archive Entry +;; Package: translate +;; Filename: translate.el +;; Version: 0.01 +;; Keywords: natural language, language, translate, translation +;; Author: Vivek Dasmohapatra <vivek@etla.org> +;; Maintainer: Vivek Dasmohapatra <vivek@etla.org> +;; Created: 2006-05-10 +;; Description: use gnome translate/libtranslate to translate text +;; Compatibility: Emacs21, Emacs22 +;; Last modified: Fri 2006-05-12 02:52:44 +0100 + + +;; Based on work by: +;; Deepak Goel <deego@gnufans.org> +;; Alejandro Benitez <benitezalejandrogm@gmail.com> + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;; You need to install libtranslate for this to work. The binary, +;; translate and the library libtranslate.so are provided (for example) +;; in Ubuntu Dapper: http://packages.ubuntu.com/dapper/libs/libtranslate-bin + +(defvar translate-version "0.01") + +(defvar translate-pairs nil + "A cache for the language pairs. A list of entries of the form: \n + '((fromaliases) (toaliases) (types)).\n +The first elements of fromaliases and toaliases are the canonical two letter +language codes (possibly with a -XX country variant extension). Any remaining +elements are human-readable aliases. (types) is a list of translation types, +usually text, and occasionally web-page as well. No other types are currently +known.") + +(defvar translate-unsupported-langs '("he" "pap") + "Languages (two/three letter codes) that we cannot utf-8 encode yet.") + +(defgroup translate nil + "Translate natural languages using gnome translate (or workalikes)." + :group 'external + :prefix "translate-") + +(defcustom translate-program "translate" + "External translation program." + :group 'translate + :type '(choice string file)) + +(defun translate-req-to-pair (from to) + "Taking a pair of string arguments, find a matching translation service +and return it as a cons of the form (\"origin\" . \"dest\")" + (translate-load-pairs) + (let ( (code nil) ) + (mapc (lambda (p) (if (and (member-ignore-case from (car p)) + (member-ignore-case to (cadr p))) + (setq code (cons (caar p) (car (cadr p))) )) ) + translate-pairs) + code)) + +(defun translate-full-name (code-or-name) + "Return the full name of a language based on a code or one of its aliases." + (interactive "sLanguage (eg en or zh-TW): ") + (translate-load-pairs) + (let ((name nil) (lang nil) (ldata translate-pairs)) + (while (and ldata (not name)) + (setq lang (car ldata) ldata (cdr ldata)) + (if (member-ignore-case code-or-name (car lang)) + (setq lang (car lang)) + (if (member-ignore-case code-or-name (cadr lang)) + (setq lang (cadr lang)) + (setq lang nil))) + (when lang + (setq name (mapconcat (lambda (l) (format "%s" l)) (cdr lang) " ")) )) + name)) + +(defconst translate-pair-regex + (concat "^\\([a-z]\\{2,3\\}\\(?:-..\\)?\\)" ;; language code (from) + "\\s-+" + "(\\(.*\\))" ;; language names (from) + "\\s-+->\\s-+" + "\\([a-z]\\{2,3\\}\\(?:-..\\)?\\)" ;; language code (to) + "\\s-+" + "(\\(.*\\)):" ;; language aliases (to) + "\\s-+" + "\\(.*\\)")) ;; capabilities + +(defun translate-parse-pair (pair-line) + "Parse a line of output from `translate-program' --list-pairs, return +an element for insertion into `translate-pairs'." + (if (string-match translate-pair-regex pair-line) + (let ( (from (match-string 1 pair-line)) + (from-alias (match-string 2 pair-line)) + (to (match-string 3 pair-line)) + (to-alias (match-string 4 pair-line)) + (cap (match-string 5 pair-line)) + (cleanup (lambda (x) (replace-regexp-in-string ",.*" "" x))) + (from-names nil) + (to-names nil)) + (setq from-alias (split-string from-alias ";") + to-alias (split-string to-alias ";") + from-alias (mapcar cleanup from-alias) + to-alias (mapcar cleanup to-alias ) + cap (split-string cap ",\\s-+")) + (mapc (lambda (x) + (let ((pos 0)) + (while (setq pos (string-match "\\<\\(\\S-+\\)\\>" x pos)) + (setq from-names (cons (match-string 1 x) from-names) + pos (match-end 1)) ))) + from-alias) + (mapc (lambda (x) + (let ((pos 0)) + (while (setq pos (string-match "\\<\\(\\S-+\\)\\>" x pos)) + (setq to-names (cons (match-string 1 x) to-names) + pos (match-end 1)) ))) + to-alias) + (list (cons from from-names) + (cons to to-names ) cap)) + (message "%S does not match.\n" pair-line) nil)) + +(defun translate-load-pairs (&optional reload) + "Parse the output of `translate-program' -l into `translate-pairs' +Called interactively with a prefix argument, or non-interactively with a +non-nil reload argument, it will empty translate-pairs first. Otherwise, +if translate-pairs has already been loaded, it will not do anything." + (interactive "P") + (if reload (setq translate-pairs nil)) + (when (not translate-pairs) + (let ( (y nil) + (pair-text (shell-command-to-string + (concat translate-program " -l"))) ) + (mapc + (lambda (x) + (when (setq y (translate-parse-pair x)) + (setq translate-pairs (cons y translate-pairs)))) + (split-string pair-text "\n")) )) + translate-pairs) + +(defun translate-list-pairs (&optional from to) + "Return the subset of `translate-pairs' that matches the FROM and TO +arguments." + (if (string-match "^\\(?:\*\\|any\\|-\\|\\)$" from) (setq from nil)) + (if (string-match "^\\(?:\*\\|any\\|-\\|\\)$" to ) (setq to nil)) + (if (not (translate-load-pairs)) + (error "translate doesn't seem to have been setup - no languages found.") + (cond + ( (and (not from) (not to)) ;; neither end point specified + translate-pairs ) + ( (or (not to) (not from)) ;; one end point specified + (let ( (op (if from 'car 'cadr)) + (op2 (if from 'cadr 'car)) + (s nil) + (fl (format "%s" (or from to))) ) + (mapc (lambda (p) (if (member-ignore-case fl (funcall op p)) + (setq s (cons p s)))) + translate-pairs) + s )) + (t ;; fully spec'd translation + (let ( (s nil) (fl (format "%s" from)) (tl (format "%s" to )) ) + (mapc (lambda (p) + (if (and (member-ignore-case fl (car p)) + (member-ignore-case tl (cadr p))) + (setq s (cons p s)) )) + translate-pairs) + s) )) )) + +(defun translate (from to &rest text) + "Given a language code or language name for the origin and destination +languages FROM and TO (see `translate-pairs') and some TEXT, returns a string +containing the translated text from `translate-program' (gnome translate +or a work-alike). If an error occurs, either internally or while invoking +`translate-program', signals an `error' instead." + (setq text (mapconcat #'(lambda (arg) (format "%s" arg)) text " ")) + ;; ======================================================================= + ;; we might have to force the locale, according to the translate docs, + ;; but this doesn't actually seem to be necessary at the moment. + ;; ----------------------------------------------------------------------- + ;; call-process should use utf-8, that's what libtranslate wants: hence + ;; we set process-coding-system-alist. + ;; ----------------------------------------------------------------------- + (let ( (from-lang (format "%s" from)) + (to-lang (format "%s" to)) + (translation nil) ;; translated text, or libtranslate error + (code nil) ;; cons of (origin-lang . dest-lang) + (status nil) );; return code of command. 0 => success. + (setq code (translate-req-to-pair from-lang to-lang) + from (car code) + to (cdr code)) + (cond + ( (not code) + (error "%s -> %s: no matching translation services found.\n" + (or (translate-full-name from-lang) from-lang) + (or (translate-full-name to-lang ) to-lang )) ) + ( (member (car code) translate-unsupported-langs) + (error "Sorry, unicode support for %s is not yet complete." + (translate-full-name from-lang)) ) + ( (member (cdr code) translate-unsupported-langs) + (error "Sorry, unicode support for %s is not yet complete." + (translate-full-name to-lang)) ) + ( t + (with-temp-buffer + (let ( (lc-all (getenv "LC_ALL")) + (lang (getenv "LANG")) + (coding-system-for-read 'utf-8) + (coding-system-for-write 'utf-8) + (process-coding-system-alist '("." . utf-8)) ) + (insert text) + (setenv "LC_ALL" nil) + (setenv "LANG" "en_GB.UTF-8") + (setq status + (call-process-region (point-min) (point-max) + translate-program + :delete-input (current-buffer) nil + "-f" from "-t" to) + translation (buffer-substring-no-properties (point-min) + (point-max))) + (setenv "LANG" lang) + (setenv "LC_ALL" lc-all) + )) )) + (if (/= 0 status) + (error "%d - %s" status translation)) + translation )) + +(provide 'translate) diff --git a/elisp/erbot/contrib/units.el b/elisp/erbot/contrib/units.el new file mode 100644 index 0000000..2e06793 --- /dev/null +++ b/elisp/erbot/contrib/units.el @@ -0,0 +1,179 @@ +;;; UNITS.EL --- units conversion + +;; Copyright (C) 2002 Linh Dang + +;; Author: Linh Dang <linhd@> +;; Maintainer: Linh Dang <linhd@> +;; Created: 16 Sep 2002 +;; Version: 1.0 +;; Keywords: conversion + + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 1, or (at your option) +;; any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; A copy of the GNU General Public License can be obtained from this +;; program's author (send electronic mail to <linhd@>) or from the +;; Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, +;; USA. + +;; LCD Archive Entry: +;; units|Linh Dang|<linhd@> +;; |units conversion +;; |$Date: 2006/01/05 18:52:02 $|$Revision: 1.1 $|~/packages/units.el + +;;; Commentary: +;; +;; Dirty hack to do units conversion using units.dat from units package. +;; likely buggy. Fixes/patches/flames/comments are welcome. +;; +;; only tested on ntemacs 21.2 + +;;; Change log: +;; $Log: units.el,v $ +;; Revision 1.1 2006/01/05 18:52:02 mwolson +;; Revision: mwolson@gnu.org--2006/erbot--cvs--0--patch-3 +;; +;; Add units.el to contrib directory. +;; +;; * contrib/units.el: Newly-added file that is recommended on the +;; ErbotInstallation page of emacswiki.org. +;; +;; Revision 1.8 2002/09/17 11:34:13 linhd +;; huh +;; +;; Revision 1.7 2002/09/17 11:27:57 linhd +;; clean +;; +;; Revision 1.6 2002/09/16 18:48:31 linhd +;; ok +;; +;; Revision 1.5 2002/09/16 16:27:33 linhd +;; works +;; +;; Revision 1.4 2002/09/16 16:21:31 linhd +;; seems to work +;; +;; Revision 1.3 2002/09/16 14:41:38 linhd +;; good +;; +;; Revision 1.2 2002/09/16 14:21:22 linhd +;; huh +;; +;; Revision 1.1 2002/09/16 14:07:59 linhd +;; Initial revision +;; + +;;; Code: + +(defconst units-version (substring "$Revision: 1.1 $" 11 -2) + "$Id: units.el,v 1.1 2006/01/05 18:52:02 mwolson Exp $ + +Report bugs to: Linh Dang <linhd@>") +(defvar units-load-hook nil + "*Hooks run after loading units.") + +(defcustom units-dat-file "/usr/share/units/units.dat" + "Dat file for UNITS." + :group 'emacs + :type '(file :must-match t)) + +(defun units-buffer () (find-file-noselect units-dat-file)) + +(defun units-s-to-n (s) + "convert a quantity string in units.dat to a number." + (if (memq ?| (mapcar 'identity s)) + (apply '/ (mapcar 'string-to-number (split-string s "|"))) + (string-to-number s))) + +(defun units-prefix-convert (prefix) + "convert PREFIX such as centi or mega to a number." + (goto-char (point-min)) + (if (re-search-forward (concat "^" prefix "\\s-+\\(\\S-+\\)\\(\\s-+#?\\)?") nil t) + (if (= (units-s-to-n (match-string-no-properties 1)) 0) + (units-prefix-convert (concat (match-string-no-properties 1) "-")) + (units-s-to-n (match-string-no-properties 1))) + 0)) + +(defvar units-si-prefix-list + '("yotta" "zetta" "exa" "peta" "tera" "giga" "mega" "myria" "kilo" + "hecto" "deca" "deka" "deci" "centi" "milli" "micro" "nano" "pico" + "femto" "atto" "zepto" "yocto" "quarter" "semi" "demi" "hemi" + "half" "double" "triple" "treble" ) + "multi-char prefixes used in SI.") + +(defvar units-si-short-prefix-list + '(?Y ?Z ?E ?P ?T ?G ?M ?k ?h ?d ?c ?m ?n ?p ?f ?a ?z ?y) + "single car prefixes used in SI (not including da)") + +(defun units-convert-1 (in quantity out) + "convert QUANTITY in IN units to OUT units. +return the amount in OUT units. This function assumed that +the current buffer contains units.dat." + (if (or (= quantity 0) (string-equal in out)) + quantity + (let (n next prefix) + (goto-char (point-min)) + (if (re-search-forward + (concat "^" in + "\\> +\\(\\([a-zA-Z]\\S-*\\)\\|!\\|\\([0-9]\\S-*\\) +\\([a-zA-Z]\\S-*\\)\\)") + nil t) + (cond ((match-beginning 4) + (setq next (match-string-no-properties 4)) + (setq n (units-s-to-n (match-string-no-properties 3))) + (if (string-equal next out) + (* n quantity) + (units-convert-1 next (* n quantity) out))) + + ((match-beginning 2) + (setq next (match-string-no-properties 2)) + (if (string-equal next out) + quantity + (units-convert-1 next quantity out)) ) + + ((string-equal (match-string-no-properties 1) "!") + (/ quantity (units-convert-1 out 1 in))) + (t + (error "internal error 1") )) + (unless (or (and (= (length in) 2) + (memq (aref in 0) units-si-short-prefix-list) + (setq prefix (concat (list (aref in 0) ?-)) + in (substring in 1))) + (and (= (length in) 3) + (= (aref in 0) ?d) + (= (aref in 1) ?a) + (setq prefix "da-" + in (substring in 2))) + (and (progn + (mapcar (lambda (pre) + (if (string-match (concat "\\`" pre) in) + (setq prefix (concat (match-string 0 in) "-") + in (substring in (match-end 0))))) + units-si-prefix-list) + prefix))) + (error "don't know how to convert %g %s to %s" quantity in out)) + (setq quantity (* (units-prefix-convert prefix) quantity)) + (if (= quantity 0) + (error "don't know how to handle %s" prefix) + (units-convert-1 in quantity out)))))) + +(defun units-convert (in quantity out) + "command to convert QUANTITY in IN units to OUT units." + (interactive "sinput unit: \nnquantity: \nsoutput unit: ") + (let ((buffer (units-buffer))) + (save-excursion + (set-buffer buffer) + (toggle-read-only 1) + (message "%g %s = %g %s" quantity in + (units-convert-1 in quantity out) out)))) + +(provide 'units) +(run-hooks 'units-load-hook) +;;; UNITS.EL ends here diff --git a/elisp/erbot/contrib/wtf.el b/elisp/erbot/contrib/wtf.el new file mode 100644 index 0000000..201b179 --- /dev/null +++ b/elisp/erbot/contrib/wtf.el @@ -0,0 +1,964 @@ +;;; wtf.el --- Look up conversational and computing acronyms + +;; Copyright (C) 2005, 2006, 2007 Michael Olson + +;; Author: Michael Olson <mwolson@gnu.org> +;; Date: Wed 16-May-2007 +;; Version: 2.0 +;; URL: http://mwolson.org/static/dist/elisp/wtf.el + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; wtf.el provides the ability to look up the definitions of popular +;; conversational and computing acronyms. + +;; * Use: +;; +;; To use this, move to an unknown acronym in a buffer and type +;; the following: +;; +;; M-x wtf-is RET +;; +;; The `wtf-is' function may also be called noninteractively, and it +;; will return a string (or nil) rather than displaying a message. +;; +;; To add a custom acronym definition, either customize +;; `wtf-custom-alist' or do: +;; +;; M-x wtf-add RET <acronym> RET <definition> RET +;; +;; To remove a custom acronym definition, or mark a pre-defined +;; acronym as "removed" in the case that no custom acronym definition +;; exists in `wtf-custom-alist' for that acronym, do: +;; +;; M-x wtf-remove RET <acronym> RET +;; +;; To mark a pre-defined acronym as "removed", without checking first +;; to see whether it is in `wtf-custom-alist', customize the +;; `wtf-removed-acronyms' option. +;; +;; If you add a custom acronym definition, and feel it to be worth +;; sharing, you are encouraged to contact <mwolson@gnu.org> via email, +;; providing the acronym and its definition. This increases the +;; chance that it will appear in future versions of wtf.el. + +;; * Legalese: +;; +;; Many of the acronym definitions were downloaded from +;; http://cvsweb.netbsd.org/bsdweb.cgi/src/share/misc/. No copyright +;; notice was included, but the intent of the original author was to +;; put these acronym definitions in the public domain. This was +;; deduced from several emails sent to the authors of these files. +;; Additionally, the original data files use a specific syntax which +;; does not allow for a copyright notice. +;; +;; The original program that uses these files in NetBSD +;; (http://cvsweb.netbsd.org/bsdweb.cgi/src/games/wtf/wtf) is in the +;; public domain. + +;; * Acknowledgments: +;; +;; Thanks to Trent Buck for `emacs-wiki-wtf.el', which inspired the +;; creation of `wtf.el'. + +;;; History: + +;; 2.0: +;; +;; - Add the `wtf-custom-alist' option, the `wtf-add' interactive +;; function to add acronyms to it, and the `wtf-remove' interactive +;; function to remove acronyms from it. Thanks to Andreas Roehler +;; for the suggestion. +;; +;; - Add a few acronyms that were scavenged from various forum FAQ +;; pages. +;; +;; - Handle multiple definitions for a single acronym more +;; intuitively. The text separator used in this case may be changed +;; by customizing the `wtf-def-separator' option. + +;; 1.1-1.4: +;; +;; - Fix a bug with completions in Emacs 21, thanks to Ehud Karni. +;; +;; - Add additional acronyms and re-sync with the NetBSD acronym list. + +;; 1.0: Initial release. + +;;; Code: + +(eval-when-compile (require 'cus-edit)) + +(defgroup wtf nil + "Options controlling the behavior of the wtf program. +wtf provides the `wtf-is' command, which looks up the definition +of the acronym at point." + :group 'convenience) + +(defcustom wtf-custom-alist nil + "Custom mappings of acronyms to definitions used by `wtf-is'. +The acronym should be uppercase, and the definition may be either +lowercase or mixed case. If mixed case, it will not be modified, +otherwise initial letters will be capitalized. + +These definitions are consulted after those in `wtf-alist'. + +This variable can also be manipulated interactively by using +`wtf-add'." + :type '(repeat (cons (string :tag "Acronym") + (string :tag "Definition"))) + :group 'wtf) + +(defcustom wtf-removed-acronyms nil + "Acronyms which exist in `wtf-alist' but should be ignored by `wtf-is'. +Each acronym should be in uppercase. +This is an easy way of removing an acronym that is felt to be +wrong or irrelevant. + +This variable can also be manipulated interactively by using +`wtf-remove'." + :type '(repeat (string :tag "Acronym")) + :group 'wtf) + +(defcustom wtf-def-separator ", or " + "Separator used when an acronym has two or more definitions." + :type 'string + :group 'wtf) + +(defvar wtf-alist + '(;; $NetBSD: acronyms,v 1.164 2007/01/31 18:37:07 elad Exp $ + ("AFAIC" . "as far as i'm concerned") + ("AFAICR" . "as far as i can recall") + ("AFAICT" . "as far as i can tell") + ("AFAIK" . "as far as i know") + ("AFAIR" . "as far as i recall") + ("AFAIU" . "as far as i understand") + ("AFD" . "away from desktop") + ("AFK" . "away from keyboard") + ("AFU" . "all fucked up") + ("AFW" . "away from window") + ("AIU" . "as i understand") + ("AIUI" . "as i understand it") + ("AKA" . "also known as") + ("ASAIC" . "as soon as i can") + ("ASAP" . "as soon as possible") + ("ATM" . "at the moment") + ("AWOL" . "absent without official leave") + ("AYBABTU" . "all your base are belong to us") + ("AYT" . "are you there") + ("B/C" . "because") + ("B/S" . "bullshit") + ("B/W" . "between") + ("BBIAB" . "be back in a bit") + ("BBL" . "[I'll] Be Back Later") + ("BBS" . "be back soon") + ("BBT" . "be back tomorrow") + ("BFD" . "big fucking deal") + ("BIAB" . "back in a bit") + ("BIAF" . "back in a few") + ("BIALW" . "back in a little while") + ("BIAS" . "back in a second") + ("BIAW" . "back in a while") + ("BOATILAS" . "bend over and take it like a slut") + ("BOFH" . "bastard operator from hell") + ("BOGAHICA" . "bend over, grab ankles, here it comes again") + ("BOHICA" . "bend over here it comes again") + ("BRB" . "[I'll] Be Right Back") + ("BS" . "bullshit") + ("BTDT" . "been there, done that") + ("BTTH" . "boot to the head") + ("BTW" . "by the way") + ("CMIIW" . "correct me if i'm wrong") + ("CNP" . "continued [in my] next post") + ("COB" . "close of business [day]") + ("COTS" . "commercial off-the-shelf") + ("CYA" . "see you around") + ("D/L" . "download") + ("DGAS" . "don't give a shit") + ("DIY" . "do it yourself") + ("DKDC" . "don't know, don't care") + ("DSTM" . "don't shoot the messenger") + ("DTRT" . "do the right thing") + ("DTWT" . "do the wrong thing") + ("DWIM" . "do what i mean") + ("EG" . "evil grin") + ("EMSG" . "email message") + ("EOB" . "end of business [day]") + ("EOD" . "end of discussion") + ("EOL" . "end of life") + ("ETA" . "estimated time of arrival") + ("ETLA" . "extended three letter acronym") + ("EWAG" . "experienced wild-ass guess") + ("FAQ" . "frequently asked question") + ("FCFS" . "first come first served") + ("FIGJAM" . "fuck i'm good, just ask me") + ("FIIK" . "fuck[ed] if i know") + ("FIIR" . "fuck[ed] if i remember") + ("FM" . "fucking magic") + ("FOAD" . "fall over and die") + ("FOS" . "full of shit") + ("FSDO" . "for some definition of") + ("FSVO" . "for some value of") + ("FTFM" . "fuck the fuckin' manual!") + ("FTL" . "for the loss") + ("FTW" . "for the win") + ("FUBAR" . "fucked up beyond all recognition") + ("FUD" . "fear, uncertainty and doubt") + ("FWIW" . "for what it's worth") + ("FYI" . "for your information") + ("G" . "grin") + ("G/C" . "garbage collect") + ("GAC" . "get a clue") + ("GAL" . "get a life") + ("GIGO" . "garbage in, garbage out") + ("GMTA" . "great minds think alike") + ("GTFO" . "get the fuck out") + ("GTG" . "got to go") + ("GWS" . "get well soon") + ("HAND" . "have a nice day") + ("HHIS" . "hanging head in shame") + ("HICA" . "here it comes again") + ("HTH" . "hope this helps") + ("IAC" . "in any case") + ("IANAL" . "i am not a lawyer") + ("IC" . "i see") + ("ICBW" . "i could be wrong") + ("ICCL" . "i couldn't care less") + ("IHAFC" . "i haven't a fucking clue") + ("IHBW" . "i have been wrong") + ("IHNFC" . "i have no fucking clue") + ("IIANM" . "if i am not mistaken") + ("IIRC" . "if i recall correctly") + ("IIUC" . "if i understand correctly") + ("IMAO" . "in my arrogant opinion") + ("IMCO" . "in my considered opinion") + ("IMHO" . "in my humble opinion") + ("IMNSHO" . "in my not so humble opinion") + ("IMO" . "in my opinion") + ("IOW" . "in other words") + ("IRL" . "in real life") + ("ISAGN" . "i see a great need") + ("ISTM" . "it seems to me") + ("ISTR" . "i seem to recall") + ("ITYM" . "i think you mean") + ("IWBNI" . "it would be nice if") + ("IYSS" . "if you say so") + ("J/K" . "just kidding") + ("JHD" . "just hit ``delete''") + ("JIC" . "just in case") + ("JK" . "just kidding") + ("JMO" . "just my opinion") + ("JSYK" . "just so you know") + ("JTLYK" . "just to let you know") + ("KISS" . "keep it simple, stupid") + ("KITA" . "kick in the ass") + ("KNF" . "kernel normal form") + ("L8R" . "later") + ("LART" . "luser attitude readjustment tool (ie, hammer)") + ("LBNL" . "last but not least") + ("LGTM" . "looks good to me") + ("LJBF" . "let's just be friends") + ("LMAO" . "laughing my ass off") + ("LMSO" . "laughing my socks off") + ("LOL" . "laughing out loud") + ("LTNS" . "long time no see") + ("MIA" . "missing in action") + ("MOTAS" . "member of the appropriate sex") + ("MOTOS" . "member of the opposite sex") + ("MOTSS" . "member of the same sex") + ("MTF" . "more to follow") + ("MYOB" . "mind your own business") + ("N/M" . "never mind") + ("NBD" . "no big deal") + ("NFC" . "no fucking clue") + ("NFI" . "no fucking idea") + ("NFW" . "no fucking way") + ("NIH" . "not invented here") + ("NMF" . "not my fault") + ("NMP" . "not my problem") + ("NOYB" . "none of your business") + ("NOYFB" . "none of your fucking business") + ("NP" . "no problem") + ("NRFPT" . "not ready for prime time") + ("NRN" . "no reply necessary") + ("NSFW" . "not suitable for work") + ("OIC" . "oh, i see") + ("OMG" . "oh, my god") + ("OT" . "off topic") + ("OTL" . "out to lunch") + ("OTOH" . "on the other hand") + ("OTT" . "over the top") + ("OTTOMH" . "off the top of my head") + ("PDQ" . "pretty darn quick") + ("PEBKAC" . "problem exists between keyboard and chair") + ("PFO" . "please fuck off") + ("PFY" . "pimply faced youth") + ("PITA" . "pain in the ass") + ("PKSP" . "pound keys and spew profanity") + ("PNG" . "persona non grata") + ("PNP" . "plug and pray") + ("POC" . "point of contact") + ("POLA" . "principle of least astonishment") + ("POLS" . "principle of least surprise") + ("POS" . "piece of shit") + ("PPL" . "pretty please") + ("PTV" . "parental tunnel vision") + ("QED" . "quod erat demonstrandum") + ("RFC" . "request for comments") + ("RIP" . "rest in peace") + ("RL" . "real life") + ("RLC" . "rod length check") + ("ROFL" . "rolling on floor laughing") + ("ROFLMAO" . "rolling on floor laughing my ass off") + ("ROTFL" . "rolling on the floor laughing") + ("RP" . "responsible person") + ("RSN" . "real soon now") + ("RTFB" . "read the fine/fucking book") + ("RTFC" . "read the fine/fucking code") + ("RTFD" . "read the fine/fucking documentation") + ("RTFM" . "read the fine/fucking manual") + ("RTFMP" . "read the fine/fucking man page") + ("RTFS" . "read the fine/fucking source") + ("SCNR" . "sorry, could not resist") + ("SEP" . "someone else's problem") + ("SFA" . "sweet fuck all") + ("SHID" . "slaps head in disgust") + ("SIMCA" . "sitting in my chair amused") + ("SMLSFB" . "so many losers, so few bullets") + ("SMOP" . "simple matter of programming") + ("SNAFU" . "situation normal, all fucked up") + ("SNERT" . "snot-nosed egotistical rude teenager") + ("SNMP" . "sorry, not my problem") + ("SNR" . "signal to noise ratio") + ("SO" . "significant other") + ("SOB" . "son of [a] bitch") + ("SOL" . "shit out [of] luck") + ("SOP" . "standard operating procedure") + ("SSIA" . "subject says it all") + ("SSTO" . "single stage to orbit") + ("STFA" . "search the fucking archives") + ("STFU" . "shut the fuck up") + ("STFW" . "search the fucking web") + ("SUS" . "stupid user syndrome") + ("SWAG" . "silly, wild-assed guess") + ("SWAHBI" . "silly, wild-assed hare-brained idea") + ("SWFG" . "search with fucking google") + ("SWMBO" . "she who must be obeyed") + ("TANSTAAFL" . "there ain't no such thing as a free lunch") + ("TBC" . "to be continued") + ("TBD" . "to be {decided,determined,done}") + ("TBH" . "to be honest") + ("TBOMK" . "the best of my knowledge") + ("THNX" . "thanks") + ("THX" . "thanks") + ("TIA" . "thanks in advance") + ("TINC" . "there is no cabal") + ("TLA" . "three letter acronym") + ("TLC" . "tender loving care") + ("TLDR" . "too long, didn't read") + ("TMA" . "too many abbreviations") + ("TMI" . "too much information") + ("TMTOWTDI" . "there's more than one way to do it") + ("TNF" . "The NetBSD Foundation") + ("TOEFL" . "test of english as a foreign language") + ("TPTB" . "the powers that be") + ("TRT" . "the right thing") + ("TTBOMK" . "to the best of my knowledge") + ("TTFN" . "ta ta for now") + ("TTYL" . "talk to you later") + ("TWIAVBP" . "the world is a very big place") + ("TY" . "thank you") + ("TYVM" . "thank you very much") + ("U/L" . "upload") + ("UTSL" . "use the source, luke") + ("VEG" . "very evil grin") + ("W/" . "with") + ("W/O" . "without") + ("WAG" . "wild-ass guess") + ("WB" . "welcome back") + ("WFH" . "working from home") + ("WFM" . "works for me") + ("WIBNI" . "wouldn't it be nice if") + ("WIP" . "work in progress") + ("WOFTAM" . "waste of fucking time and money") + ("WOMBAT" . "waste of money, brain, and time") + ("WRT" . "with respect to") + ("WTF" . "{what,where,who,why} the fuck") + ("WTH" . "{what,where,who,why} the hell") + ("WYSIWYG" . "what you see is what you get") + ("YALIMO" . "you are lame, in my opinion") + ("YHBT" . "you have been trolled") + ("YHL" . "you have lost") + ("YKWIM" . "you know what i mean") + ("YMA" . "yo momma's ass") + ("YMMV" . "your mileage may vary") + ("YW" . "you're welcome") + ;; $NetBSD: acronyms.comp,v 1.72 2007/01/19 + ("3WHS" . "three-way handshake") + ("ABI" . "application binary interface") + ("ACL" . "access control list") + ("ACPI" . "advanced configuration and power interface") + ("ADC" . "analog [to] digital converter") + ("ADPCM" . "adaptive differential pulse code modulation") + ("ADSL" . "asymmetric digital subscriber line") + ("AGP" . "accelerated graphics port") + ("AM" . "amplitude modulation") + ("AMI" . "alternate mark inversion") + ("ANSI" . "american national standards institute") + ("AP" . "access point") + ("API" . "application programming interface") + ("APIC" . "advanced programmable interrupt controller") + ("ARP" . "address resolution protocol") + ("ARQ" . "automatic repeat request") + ("AS" . "autonomous system") + ("ASCII" . "american standard code for information interchange") + ("ASN" . "autonomous system number") + ("AT" . "advanced technology") + ("ATA" . "advanced technology attachment") + ("ATAPI" . "advanced technology attachment packet interface") + ("ATC" . "address translation cache") + ("ATM" . "asynchronous transfer mode") + ("ATX" . "advanced technology extended") + ("BEDO" . "burst extended data output") + ("BER" . "basic encoding rules") + ("BER" . "bit error rate") + ("BGP" . "border gateway protocol") + ("BIOS" . "basic input/output system") + ("BLOB" . "binary large object") + ("BPS" . "bits per second") + ("BQS" . "berkeley quality software") + ("BSD" . "berkeley software distribution") + ("CAD" . "computer-aided design") + ("CARP" . "common address redundancy protocol") + ("CAV" . "Constant Angular Velocity (as opposed to CLV)") + ("CCD" . "charge coupled device") + ("CD" . "compact disc") + ("CDDA" . "compact disc digital audio") + ("CDRAM" . "cache dynamic random access memory") + ("CER" . "canonical encoding rules") + ("CGA" . "color graphics {array,adapter}") + ("CGI" . "common gateway interface") + ("CHS" . "cylinder/head/sector") + ("CIDR" . "classless inter-domain routing") + ("CIS" . "contact image sensor") + ("CLI" . "command line interface") + ("CLUT" . "color look-up table") + ("CLV" . "Constant Linear Velocity (as opposed to CAV)") + ("CMYK" . "cyan magenta yellow black") + ("COFF" . "common object file format") + ("COW" . "copy-on-write") + ("CPU" . "central processing unit") + ("CRLF" . "carriage return line feed") + ("CRT" . "cathode ray tube") + ("CSMA" . "carrier sense multiple access") + ("CSMA/CA" . "carrier sense multiple access with collision avoidance") + ("CSMA/CD" . "carrier sense multiple access with collision detection") + ("CSS" . "cascading style sheets") + ("CTS" . "clear to send") + ("CVS" . "concurrent versions system") + ("DAC" . "digital [to] analog converter") + ("DCE" . "data control equipment") + ("DCE" . "distributed computing environment") + ("DCT" . "discrete cosine transform") + ("DDC" . "display data channel") + ("DDR" . "double data rate") + ("DDWG" . "digital display working group") + ("DER" . "distinguished encoding rules") + ("DFT" . "discrete fourier transform") + ("DHCP" . "dynamic host configuration protocol") + ("DIFS" . "distributed inter-frame space") + ("DLE" . "data link escape") + ("DMA" . "direct memory access") + ("DNS" . "domain name system") + ("DOS" . "denial of service") + ("DPCM" . "differential pulse code modulation") + ("DPD" . "dead peer detection") + ("DPI" . "dots per inch") + ("DRAM" . "dynamic random access memory") + ("DSL" . "digital subscriber line") + ("DSSS" . "direct sequence spread spectrum") + ("DTD" . "document type definition") + ("DTE" . "data terminal equipment") + ("DTE" . "dumb terminal emulator") + ("DVD" . "digital versatile disc") + ("DVI" . "digital visual interface") + ("E-XER" . "Extended XML encoding Rules") + ("EAP" . "extensible authentication protocol") + ("ECP" . "enhanced capability port") + ("EDID" . "extended display identification data") + ("EDO" . "extended data out") + ("EEPROM" . "electrically erasable programmable read only memory") + ("EFI" . "extensible firmware interface") + ("EFM" . "eight to fourteen modulation") + ("EGA" . "enhanced graphics {array,adapter}") + ("EGP" . "exterior gateway protocol") + ("EISA" . "extended industry standard architecture") + ("ELF" . "executable and linking format") + ("EOF" . "end of file") + ("EOT" . "end of transmission") + ("EPP" . "enhanced parallel port") + ("EPRML" . "extended partial response, maximum likelihood") + ("EPROM" . "erasable programmable read only memory") + ("ESDRAM" . "enhanced synchronous dynamic random access memory") + ("FAT" . "file allocation table") + ("FBRAM" . "frame buffer random access memory") + ("FCS" . "frame check sequence") + ("FDDI" . "fiber distributed data interface") + ("FFS" . "fast file system") + ("FHSS" . "frequency hop spread spectrum") + ("FIR" . "fast infrared") + ("FLOPS" . "floating [point] operations per second") + ("FM" . "frequency modulation") + ("FPM" . "fast page mode") + ("FQDN" . "fully qualified domain name") + ("FTP" . "file transfer protocol") + ("FTPS" . "file transfer protocol, secure") + ("GC" . "garbage collector") + ("GCR" . "group-coded recording") + ("GIF" . "graphics interchange format") + ("GNU" . "GNU's Not UNIX") + ("GPL" . "GNU/General Public License") + ("GPU" . "graphics processing unit") + ("GRE" . "generic routing encapsulation") + ("GUI" . "graphics user interface") + ("HDCP" . "high-bandwidth digital content protection") + ("HTML" . "hyper-text markup language") + ("HTTP" . "hyper-text transfer protocol") + ("HTTPS" . "hyper-text transfer protocol, secure") + ("I2O" . "intelligent input/output") + ("IANA" . "internet assigned number authority") + ("IC" . "integrated circuit") + ("ICB" . "internet citizen's band") + ("ICMP" . "internet control message protocol") + ("IDE" . "integrated drive electronics") + ("IDRP" . "inter-domain routing protocol") + ("IEC" . "international electrotechnical commission") + ("IEEE" . "institute [of] electrical [and] electronics engineers") + ("IESG" . "internet engineering steering group") + ("IETF" . "internet engineering task force") + ("IGP" . "interior gateway protocol") + ("IKE" . "internet key exchange") + ("IMAP" . "internet mail access protocol") + ("INCITS" . "international committee on information technology standards") + ("IO" . "input/output") + ("IOCTL" . "input/output control") + ("IP" . "internet protocol") + ("IPC" . "interprocess communication") + ("IPNG" . "internet protocol, next generation") + ("IPSEC" . "internet protocol security") + ("IRC" . "internet relay chat") + ("IRQ" . "interrupt request") + ("IRTF" . "internet research task force") + ("ISA" . "industry standard architecture") + ("ISDN" . "integrated services digital network") + ("ISI" . "inter-symbol interference") + ("ISM" . "industrial, scientific and medical") + ("ISN" . "initial serial number") + ("ISO" . "international standards organization") + ("ISOC" . "internet society") + ("ISP" . "internet service provider") + ("JPEG" . "joint photographic experts group") + ("KPI" . "kernel programming interface") + ("KVA" . "kernel virtual address") + ("KVM" . "keyboard, video, mouse switch") + ("LAN" . "local area network") + ("LBA" . "logical block addressing") + ("LCD" . "liquid crystal display") + ("LCP" . "link control protocol") + ("LDAP" . "lightweight directory access protocol") + ("LED" . "light emitting diode") + ("LIR" . "local internet registry") + ("LKM" . "{linux, loadable} kernel module") + ("LLC" . "logical link control") + ("LRC" . "longitudinal redundancy check") + ("LSB" . "least significant {bit,byte}") + ("LSB" . "linux standards base") + ("LUN" . "logical unit number") + ("LZW" . "Lempel Ziv Welch") + ("MAC" . "medium access control") + ("MBR" . "master boot record") + ("MDRAM" . "multibank dynamic random access memory") + ("MFM" . "modified frequency modulation") + ("MIDI" . "musical instrument digital interface") + ("MIME" . "multipurpose internet mail extensions") + ("MIPS" . "million instructions per second") + ("MMU" . "memory management unit") + ("MPEG" . "moving picture experts group") + ("MPLS" . "multiprotocol label switching") + ("MSB" . "most significant {bit,byte}") + ("MSF" . "minutes seconds frames") + ("MSS" . "maximum segment size") + ("MTA" . "mail transfer agent") + ("MTU" . "maximum transmission unit") + ("MUA" . "mail user agent") + ("MWE" . "module width encoding") + ("NAT" . "network address translation") + ("NAV" . "network allocation vector") + ("NCP" . "network control protocol") + ("NCQ" . "native command queuing") + ("NFS" . "network file system") + ("NIC" . "network interface card") + ("NIS" . "network information service") + ("NRZ" . "non-return to zero") + ("NUMA" . "non uniform memory access") + ("OCL" . "object constraint language") + ("OCR" . "optical character recognition") + ("OEM" . "original equipment manufacturer") + ("OFDM" . "orthogonal frequency division multiplexing") + ("OSF" . "open software foundation") + ("OSI" . "open systems interconnection") + ("OSI" . "open-source initiative") + ("OSPF" . "open shortest path first") + ("OTP" . "one time password") + ("PAM" . "pluggable authentication modules") + ("PAM" . "pulse amplitude modulation") + ("PAT" . "port address translation") + ("PAX" . "portable archive exchange") + ("PC" . "personal computer") + ("PCI" . "peripheral component interconnect") + ("PCM" . "pulse code modulation") + ("PCMCIA" . "personal computer memory card international association") + ("PDP" . "page descriptor page") + ("PDU" . "protocol data unit") + ("PER" . "packed encoding rules") + ("PERL" . "practical extraction [and] report language") + ("PFS" . "perfect forward secrecy") + ("PGP" . "pretty good privacy") + ("PIC" . "programmable interrupt controller") + ("PID" . "process id") + ("PIN" . "personal identification number") + ("PIO" . "programmed input/output") + ("PLL" . "phase locked loop") + ("PMT" . "photo-multiplier tube") + ("PNG" . "portable network graphics") + ("POP" . "post office protocol") + ("POSIX" . "Portable Operating System Interface [for] UNIX") + ("POST" . "power on self test") + ("POTS" . "plain old telephone system") + ("PPP" . "point-to-point protocol") + ("PPPOA" . "point-to-point protocol over ATM") + ("PPPOE" . "point-to-point protocol over ethernet") + ("PRML" . "partial response, maximum likelihood") + ("PROM" . "programmable read only memory") + ("PSK" . "pre-shared key") + ("PSTN" . "public switched telephone network") + ("PTE" . "page table entry") + ("PTLA" . "pseudo top level aggregator") + ("PTP" . "page table page") + ("PWM" . "pulse width modulation") + ("QOS" . "quality of service") + ("RAID" . "redundant array of inexpensive disks") + ("RAM" . "random access memory") + ("RCS" . "revision control system") + ("RGB" . "red green blue") + ("RIFF" . "Resource Interchange File Format") + ("RIP" . "routing information protocol") + ("RIR" . "regional internet registry") + ("RISC" . "reduced instruction set computing") + ("RLE" . "run length encoding") + ("RLL" . "run length limited") + ("ROM" . "read only memory") + ("RPM" . "revolutions per minute") + ("RTF" . "rich text format") + ("RTS" . "request to send") + ("RTT" . "round time trip") + ("S/PDIF" . "sony/phillips digital interface") + ("SACD" . "super audio compact disc") + ("SAD" . "security association database") + ("SAM" . "serial access memory") + ("SASI" . "Shugart Associates System Interface (predecessor to SCSI)") + ("SATA" . "serial advanced technology attachment") + ("SB" . "sound blaster") + ("SCM" . "software configuration management") + ("SCM" . "source code management") + ("SCSI" . "small computer system interface") + ("SDRAM" . "synchronous dynamic random access memory") + ("SGRAM" . "synchronous graphics random access memory") + ("SIFS" . "short inter-frame space") + ("SIP" . "session initiation protocol") + ("SIR" . "slow infrared") + ("SLDRAM" . "synchronous-link dynamic random access memory") + ("SMART" . "self-monitoring analysis and reporting technology") + ("SMP" . "symmetric multiprocessing") + ("SMTP" . "simple mail transfer protocol") + ("SNMP" . "simple network management protocol") + ("SPD" . "security policy database") + ("SPD" . "serial presence detect") + ("SRAM" . "static random access memory") + ("SSFDC" . "solid state floppy disc card") + ("SSH" . "secure shell") + ("SSL" . "secure sockets layer") + ("STP" . "shielded twisted pair") + ("SVGA" . "super video graphics {array,adapter}") + ("TCL" . "tool command language") + ("TCP" . "transmission control protocol") + ("TCQ" . "tagged command queueing") + ("TDD" . "test driven development") + ("TFT" . "thin film transistor") + ("TFTP" . "trivial file transfer protocol") + ("TIFF" . "tagged image file format") + ("TLA" . "top level aggregator") + ("TLB" . "transition lookaside buffer") + ("TLD" . "top level domain") + ("TLS" . "transport layer security") + ("TMDS" . "transition minimized differential signaling") + ("TR" . "token ring") + ("TTL" . "time to live") + ("TTY" . "teletype") + ("TZ" . "time zone") + ("UART" . "universal asynchronous receiver/transmitter") + ("UC" . "uncacheable") + ("UDO" . "ultra density optical (storage)") + ("UDP" . "user datagram protocol") + ("UFS" . "UNIX file system") + ("UML" . "unified modeling language") + ("UPS" . "uninterruptible power supply") + ("URI" . "uniform resource identifier") + ("URL" . "uniform resource locator") + ("USART" . "universal synchronous/asynchronous receiver/transmitter") + ("USB" . "universal serial bus") + ("USWC" . "uncacheable speculative write combining") + ("UTP" . "unshielded twisted pair") + ("UUCP" . "unix-to-unix copy protocol") + ("UUOC" . "useless use of cat") + ("VAX" . "virtual address extension") + ("VCM" . "virtual channel memory") + ("VESA" . "video electronics standards association") + ("VGA" . "video graphics {array,adapter}") + ("WIFI" . "wireless fidelity") + ("VLAN" . "virtual local area network") + ("VLSM" . "variable length subnet mask") + ("VM" . "virtual {machine,memory}") + ("VPN" . "virtual private network") + ("VRAM" . "video random access memory") + ("VRRP" . "virtual router redundancy protocol") + ("WAN" . "wide area network") + ("WAP" . "wireless application protocol") + ("WEP" . "wired equivalent privacy") + ("WLAN" . "wireless local area network") + ("WPA" . "wi-fi protected access") + ("WRAM" . "window random access memory") + ("WWW" . "world wide web") + ("XER" . "XML Encoding Rules") + ("XGA" . "extended graphics {array,adapter}") + ("XML" . "extensible markup language") + ("XSL" . "extensible stylesheet language") + ("XT" . "extended technology") + ("ZFOD" . "zero-filled on demand") + ;; Additional acronym definitions go here + ("AAMOF" . "as a matter of fact") + ("AISI" . "as i see it") + ("ASAIMS" . "as strange as it may seem") + ("ATSL" . "along the same line") + ("AYOR" . "at your own risk") + ("BTAIM" . "be that as it may") + ("BTDTBTTS" . "been there, done that, bought the t-shirt") + ("BTHOM" . "beats the hell outta me") + ("CBA" . "can't be arsed") + ("DBD" . "Defective By Design") + ("DIIK" . "damned if i know") + ("EFF" . "Electronic Frontier Foundation") + ("FFII" . "Foundation for a Free Information Infrastructure") + ("FOAF" . "friend of a friend") + ("FSF" . "Free Software Foundation") + ("FTR" . "for the record") + ("FTBFS" . "failure to build from source") + ("GAFC" . "get a fucking clue") + ("IAE" . "in any event") + ("IBTD" . "i beg to differ") + ("ICBF" . "i can't be fucked") + ("IDS" . "intrusion detection system") + ("IDK" . "i don't know") + ("IJWTS" . "i just want to say") + ("IME" . "in my experience") + ("IYSWIM" . "if you see what i mean") + ("JFTR" . "just for the record") + ("NIFOC" . "naked in front of computer") + ("NPOV" . "neutral point of view") + ("PITB" . "pain in the butt") + ("POV" . "point of view") + ("ROTFLMAO" . "rolling on the floor laughing my ass off") + ("SWIM" . "see what i mean") + ("TNSTAAFL" . "there's no such thing as a free lunch") + ("TWAT" . "the war against terrorism") + ("WDOT" . "what do others think") + ("WDYMBT" . "what do you mean by that") + ("WDYT" . "what do you think") + ("WTB" . "where's the beef") + ("WTSHTF" . "when the shit hits the fan") + ("WTTM" . "without thinking too much") + ("WOTAM" . "waste of time and money") + ("YAGNI" . "you ain't gonna need it") + ("YGWYPF" . "you get what you pay for")) + "Mapping of acronyms to definitions.") + +;;; Utilities + +(defun wtf-match-string-no-properties (num &optional string) + "Return NUMth match of STRING sans text properties." + (if (fboundp 'match-string-no-properties) + (match-string-no-properties num string) + (match-string num string))) + +(defun wtf-remove-one (key alist) + "Remove only the first instance of KEY from ALIST. +ALIST should be a symbol, the value of which is modified directly. +Returns non-nil if an element was found and removed, nil otherwise." + (let ((svalist (symbol-value alist))) + (if (equal key (caar svalist)) + (prog1 t + (set alist (cdr svalist))) + (catch 'done + (let ((cur (cadr svalist)) + (prev svalist)) + (while cur + (if (equal key (car cur)) + (throw 'done + (prog1 t + (setcdr prev (cddr prev)))) + (setq prev (cdr prev) + cur (cadr prev)))) + nil))))) + +(defun wtf-multi-assoc (key &rest alists) + "Return a list of all values in all ALISTS that are associated with KEY." + (let ((vals nil)) + (dolist (alist alists) + (dolist (pair alist) + (when (equal key (car pair)) + (setq vals (cons (cdr pair) vals))))) + (nreverse vals))) + +(defun wtf-upcase-initials (string) + "Do `upcase-initials' on STRING, but do not uppercase letters +that come after quote characters. + +This function clobbers the match data." + (with-temp-buffer + (insert (upcase-initials string)) + (goto-char (point-min)) + (while (re-search-forward "['`]\\([[:upper:]]\\)" nil t) + (downcase-region (match-beginning 1) (match-end 1))) + (buffer-string))) + +(defun wtf-upcase-initials-maybe (string) + "Do `wtf-upcase-initials' on STRING only if STRING contains no +existing capitalization. + +This function clobbers the match data." + (let ((case-fold-search nil)) + (if (string-match "[A-Z]" string) + string + (wtf-upcase-initials string)))) + +;;; Implementation + +(defun wtf-lookup-term (term) + (setq term (upcase term)) + (wtf-multi-assoc term + (and (not (member term wtf-removed-acronyms)) + wtf-alist) + wtf-custom-alist)) + +(defun wtf-get-term-at-point () + "Return the term at point." + (interactive) + (save-excursion + (if (re-search-backward "\\W" (point-min) t) + (goto-char (1+ (point))) + (beginning-of-line)) + (when (looking-at "\\w+") + (let ((term (wtf-match-string-no-properties 0))) + (when (wtf-lookup-term term) + (downcase term)))))) + +(defun wtf-completions () + "Return a list of completions for terms." + (mapcar #'(lambda (term) + (list (downcase (car term)))) + (append wtf-alist wtf-custom-alist))) + +(defun wtf-save-maybe (var) + "If customizations are allowed, save VAR, which should be a symbol." + (when (fboundp 'customize-save-variable) + (customize-save-variable var (symbol-value var)) + (message "Saved wtf customization"))) + +;;; Interactive functions + +;;;###autoload +(defun wtf-add (acronym definition) + "Add ACRONYM and its DEFINITION to the list of custom associations. + +If you add a custom acronym definition, and feel it to be worth +sharing, you are encouraged to contact <mwolson@gnu.org> via +email, providing the acronym and its definition. This increases +the chance that it will appear in future versions of wtf.el." + (interactive "sAcronym: \nsDefinition: ") + (setq acronym (upcase acronym)) + (setq wtf-custom-alist (sort (cons (cons acronym definition) + wtf-custom-alist) + #'(lambda (a b) + (string< (car a) (car b))))) + (wtf-save-maybe 'wtf-custom-alist)) + +;;;###autoload +(defun wtf-remove (acronym) + "Remove ACRONYM from the list of custom associations. +If ACRONYM is not in the custom associations, but instead in +`wtf-alist', it will be marked as ignored by adding it to +`wtf-removed-acronyms'." + (interactive + (list (completing-read "Acronym to remove: " + (wtf-completions) nil t (wtf-get-term-at-point)))) + (setq acronym (upcase acronym)) + (if (wtf-remove-one acronym 'wtf-custom-alist) + (wtf-save-maybe 'wtf-custom-alist) + (add-to-list 'wtf-removed-acronyms acronym) + (wtf-save-maybe 'wtf-removed-acronyms))) + +;;;###autoload +(defun wtf-is (acronym) + "Provide the definition for ACRONYM. +When called interactively, display the message \"ACRONYM is DEF\". +Otherwise, return DEF. + +DEF refers to the definition associated with ACRONYM in `wtf-alist'." + (interactive + (list (completing-read "Acronym: " + (wtf-completions) nil t (wtf-get-term-at-point)))) + (when (stringp acronym) + (let ((defs (wtf-lookup-term acronym))) + (if (not defs) + (when (interactive-p) + (message "I don't know what %s means" (upcase acronym))) + (save-match-data + (let ((deftext (wtf-upcase-initials-maybe (car defs)))) + (when (cdr defs) + (dolist (def (cdr defs)) + (setq deftext (concat deftext wtf-def-separator + (wtf-upcase-initials-maybe def))))) + (if (interactive-p) + (message "%s is %s" (upcase acronym) deftext) + deftext))))))) + +(provide 'wtf) + +;;; wtf.el ends here diff --git a/elisp/erbot/erball.el b/elisp/erbot/erball.el new file mode 100644 index 0000000..e5e48ae --- /dev/null +++ b/elisp/erbot/erball.el @@ -0,0 +1,209 @@ +;;; erball.el --- Functions on all files. +;; Time-stamp: <2006-04-24 13:43:38 deego> +;; Copyright (C) 2002 D. Goel +;; Emacs Lisp Archive entry +;; Filename: erbc.el +;; Package: erbc +;; Author: D. Goel <deego@gnufans.org> +;; Version: + + + +;; Usually maintenance +;; not all of these may be required depending on how you use erbot.. +(require 'cl) + +;; Compilation + +(defvar erball-compilation-paths-rel-to + (let (args ret) + (while command-line-args-left + (if (string= "--paths-rel-to" (car command-line-args-left)) + (progn + (setq ret (cadr command-line-args-left)) + (setq command-line-args-left (cddr command-line-args-left))) + (add-to-list 'args (car command-line-args-left) t) + (setq command-line-args-left (cdr command-line-args-left)))) + (setq command-line-args-left args) + ret) + "Text to be prepended to each element in `erball-compilation-paths'. +Can be specified by passing \"--paths-rel-to ARG\" on the emacs +command line. +This value is also added to the load-path. +A trailing backslash is required.") + +(defun erball-assoc-string (key list) + "Like `assoc' but specifically for strings." + (if (fboundp 'assoc-string) + (assoc-string key list) + (catch 'found + (dolist (el list) + (when (string= key el) + (throw 'found el)))))) + +(defvar erball-compiling-p + (if (erball-assoc-string "--compile-erbot" command-line-args-left) + (progn + (message "%s" (concat "\nCompiling source in " + (file-name-nondirectory (expand-file-name ".")) + " ...\n")) + (setq command-line-args-left + (delete "--compile-erbot" command-line-args-left)) + t) + nil) + "Determine whether erbot is currently being compiled.") + +(defcustom erball-compilation-paths + '("contrib" + ".." + "../erc" + "../bbdb/lisp") + "Elements to add to the load path during compilation. +If `erball-compilation-paths-rel-to' is specified, it is +prepended to each element and also added verbatim to the path. +The current directory is automatically added to the path." + :group 'erball + ) + +(when erball-compiling-p + (add-to-list 'load-path ".") + (when erball-compilation-paths-rel-to + (add-to-list 'load-path erball-compilation-paths-rel-to)) + (dolist (dir erball-compilation-paths) + (add-to-list 'load-path + (concat erball-compilation-paths-rel-to dir)))) + +;; Load all erbot files + +(defmacro erball-ignore-errors-loudly (&rest body) + "Like ignore-errors, but tells the error.. + +Copied from deego's `ignore-errors-my', which owes some of its work +to: Kalle on 7/3/01: + * used backquote: something i was too lazy to convert my macro to.. + * removed the progn: condition-case automatically has one.. + * made sure that the return is nil.. just as it is in ignore-errors. " + (let ((err (gensym))) + `(condition-case ,err (progn ,@body) + (error + (ding t) + (ding t) + (ding t) + (message "IGNORED ERROR: %s" (error-message-string ,err)) + (sit-for 1) + nil)))) + + + +(erball-ignore-errors-loudly (require 'bbdb)) +(erball-ignore-errors-loudly (require 'doctor)) +(erball-ignore-errors-loudly (require 'erc)) +(erball-ignore-errors-loudly (require 'erc-stamp)) + + + +(unless noninteractive (erball-ignore-errors-loudly (require 'dunnet))) +(erball-ignore-errors-loudly (require 'erbot)) +(erball-ignore-errors-loudly (require 'erbcountry)) +(erball-ignore-errors-loudly (require 'erbutils)) +(erball-ignore-errors-loudly (require 'erblog)) +(erball-ignore-errors-loudly (require 'erbeng)) +(erball-ignore-errors-loudly (require 'erbdata)) +(erball-ignore-errors-loudly (require 'erbkarma)) +(erball-ignore-errors-loudly (require 'erblisp)) +(erball-ignore-errors-loudly (require 'erbc)) +(erball-ignore-errors-loudly (require 'erbc2)) +(erball-ignore-errors-loudly (require 'erbc3)) +(erball-ignore-errors-loudly (require 'erbc4)) +(erball-ignore-errors-loudly (require 'erbc5)) +(erball-ignore-errors-loudly (require 'erbc6)) +(erball-ignore-errors-loudly (require 'erbcspecial)) +(erball-ignore-errors-loudly (require 'erbbdb)) +(erball-ignore-errors-loudly (require 'erbforget)) +(erball-ignore-errors-loudly (require 'erbedit)) +(erball-ignore-errors-loudly (require 'erbtrain)) +(erball-ignore-errors-loudly (require 'erbwiki)) +(erball-ignore-errors-loudly (require 'erbunlisp)) +(erball-ignore-errors-loudly (require 'erbcompat)) + +(erball-ignore-errors-loudly (require 'erbmsg)) +(erball-ignore-errors-loudly (require 'erbtranslate)) +(erball-ignore-errors-loudly (require 'erbim)) + +(erball-ignore-errors-loudly (require 'flame)) + +(erball-ignore-errors-loudly (require 'mkback)) +(erball-ignore-errors-loudly (require 'lines)) +(erball-ignore-errors-loudly (require 'google)) +(erball-ignore-errors-loudly (require 'oct)) + +;; the rest of the commands here are useful to the author when editing erbot. + +(defcustom erball-files + (if erball-compiling-p + (directory-files "." nil "\.el$") + '("erbot.el" + "erbutils.el" + "erblog.el" + "erbeng.el" + "erbcountry.el" + "erbdata.el" + "erbedit.el" + "erbforget.el" + "erbkarma.el" + "erblisp.el" + "erbunlisp.el" + "erbtrain.el" + "erbwiki.el" + "erbc.el" + "erbc2.el" + "erbc3.el" + "erbc4.el" + "erbc5.el" + "erbc6.el" + )) + + "" + :group 'erball + ) + +(defun erball-reload () + (interactive) + (mapcar + 'load + erball-files)) + +(defun erball-visit () + (interactive) + (mapcar + (lambda (a) + (find-file (locate-library a)) + (auto-revert-mode 1)) + erball-files)) + +;;;###autoload +(defun erball-compile () + (interactive) + (if erball-compiling-p + (progn + (ignore-errors (erball-reload)) + (mapcar + (lambda (arg) + (erball-ignore-errors-loudly + (byte-compile-file arg))) + erball-files) + (message "\nCompilation complete!\n")) + (ignore-errors (kill-buffer "*Compile-Log*")) + (erball-visit) + (erball-reload) + (mapcar + (lambda (arg) + (erball-ignore-errors-loudly + (byte-compile-file (locate-library arg)))) + erball-files) + (switch-to-buffer "*Compile-Log*") + (delete-other-windows) + (goto-char (point-min)))) + + +(provide 'erball) diff --git a/elisp/erbot/erbbdb.el b/elisp/erbot/erbbdb.el new file mode 100644 index 0000000..30684a5 --- /dev/null +++ b/elisp/erbot/erbbdb.el @@ -0,0 +1,223 @@ +;;; erbbdb.el --- +;; Time-stamp: <2007-11-23 11:30:13 deego> +;; Copyright (C) 2002 D. Goel +;; Emacs Lisp Archive entry +;; Filename: erbbdb.el +;; Package: erbbdb +;; Author: D. Goel <deego@gnufans.org> +;; Version: 0.0dev +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +;; See also: + + + + +(defvar erbbdb-version "0.0dev") + +;;========================================== +;;; Code: +(ignore-errors (require 'bbdb)) +(ignore-errors (require 'bbdb-com)) +(ignore-errors (require 'bbdb-hooks)) + +(require 'erbc) + +(defgroup erbbdb nil + "The group erbbdb" + :group 'applications) +(defcustom erbbdb-before-load-hooks nil "." :group 'erbbdb) +(defcustom erbbdb-after-load-hooks nil "" :group 'erbbdb) +(run-hooks 'erbbdb-before-load-hooks) + + +(defun erbbdb-get-exact-notes (string) + (erbbdb-get-regexp-notes (concat "^" (regexp-quote + (erbbdb-frob-main-entry string) + ) "$"))) + +(defun erbbdb-get-exact-name (string) + (erbbdb-get-regexp-name (concat "^" (regexp-quote + (erbbdb-frob-main-entry string) + ) "$"))) + + + +(defun erbbdb-get-regexp-record (expr) + "dsfdfdf" + (let ((records + (bbdb-search (bbdb-records) + expr))) + (first records))) + +(defun erbbdb-get-record (str) + (erbbdb-get-regexp-record + (concat "^" (regexp-quote + (erbbdb-frob-main-entry str)) "$"))) + +(defun erbbdb-get-regexp-name (expr) + "used to get exact name, eg: the exact name of tmpa may be TmpA." + (let ((record (car + ;; this basically does an M-x bbdb-name + (bbdb-search (bbdb-records) + expr)))) + (if record + (aref record 0) + nil))) + +(defun erbbdb-get-regexp-notes (expr) + "currently: Assumes that there will be only one match for the expr +in bbdb... Discards any further matches... + +If the notes are (), we want it to return nil, not a string.. so that +the calling function knows there's (effectively) no such record... + +That is why we have the read below.. + +This of course, also means that the notes field had better contain a +lisp sexp.. and anythign after the sexp gets discarded... + +If record exists but no notes exist, \"\" is returned. +Else the string containing the notes is returned. +If no record exists, then a nil is returned. +" + (let ((record (car + ;; this basically does an M-x bbdb-name + (bbdb-search (bbdb-records) + expr)))) + (if record + (let* ((notes-notes (assq 'notes (bbdb-record-raw-notes record))) + (notes-string (cdr notes-notes))) + (or notes-string "") + ;;(if foo (read foo) nil) + ) + nil))) + + +(defun erbbdb-frob-main-entry (givenname) + (let* ((sname (format "%s" givenname)) + ;;(dname (downcase sname)) + (dname sname) + (bname (split-string dname)) + (name (mapconcat 'identity bname "-"))) + name)) + +(defun erbbdb-change (givenname notes) + "also used by other functions in here.." + + (bbdb-records) + + (let* ((sname (format "%s" givenname)) + ;;(dname (downcase sname)) + (dname sname) + (bname (split-string dname)) + (name (mapconcat 'identity bname "-"))) + ;;(let ((record + ;; (vector + ;; ;; first name + ;; name + ;; ;;lastname + ;; nil + ;; nil + ;; nil ;;company + ;; nil ;;phones + ;; nil ;; addrs + ;; nil ;;net + ;; (format "%s" notes) + ;; ; (make-vector bbdb-cache-length nil)))) + ;; (bbdb-change-record record t)) + (let* ((record (erbbdb-get-record name))) + (bbdb-record-set-notes record notes) + (bbdb-change-record record t) + (erbbdb-save)))) + +(defun erbbdb-save () + (when + erbbdb-save-p + (bbdb-save-db))) + +(defvar erbbdb-save-p t + "Should normally be t, except inside special constructions. ") + + +(defun erbbdb-create (name newnotes) + "also used by other functions in here.." + (bbdb-records) + (let ((record + (vector + ;; first name + name + ;;lastname + nil + nil + nil ;;company + nil ;;phones + nil ;; addrs + nil ;;net + nil ;; (format "%s" newnotes) + (make-vector bbdb-cache-length nil)))) + (bbdb-record-set-notes record nil) + (mapcar '(lambda (arg) + (erbbdb-add name arg)) + newnotes) + ) + (erbbdb-save)) + +(defun erbbdb-add (name note) + (bbdb-records) + (let* ((oldnotes + (erbbdb-get-exact-notes name)) + (newnotes nil)) + + ;; should almost always be the case.. except when nil.. + (if (stringp oldnotes) + (setq oldnotes + (ignore-errors (erbn-read oldnotes)))) + (setq newnotes (format "%S" (append oldnotes (list note)))) + (erbbdb-remove-not-really name) + (erbbdb-change name newnotes))) + + +(defun erbbdb-remove-not-really (name) + (erbbdb-change name nil)) +(defun erbbdb-remove (givenname) + "Remove the record implied by givenname from bbdb.." + ;;(erbbdb-change name nil) + (bbdb-records) + (let* ((sname (format "%s" givenname)) + ;;(dname (downcase sname)) + (dname sname) + (bname (split-string dname)) + (name (mapconcat 'identity bname "-"))) + (let* ((record (erbbdb-get-record name))) + (when record + (bbdb-delete-current-record record t) + ;;(bbdb-record-set-notes record notes) + ;;(bbdb-change-record record t) + (erbbdb-save))))) + +(provide 'erbbdb) +(run-hooks 'erbbdb-after-load-hooks) + + + +;;; erbbdb.el ends here diff --git a/elisp/erbot/erbc-backquote.el b/elisp/erbot/erbc-backquote.el new file mode 100644 index 0000000..b61fbec --- /dev/null +++ b/elisp/erbot/erbc-backquote.el @@ -0,0 +1,57 @@ +;; 2004-08-20 T14:53:35-0400 (Friday) D. Goel +;; This file is work in progress. INCOMLPETE AND BUGGY. DO NOT REQUIRE +;; THIS FILE IN A BOT. + + +(defvar backquote-symbols (list (intern (string 96)) 'backquote)) + + +(defmacro backquote-parse (sexp) + "Will parse a sexp and return an equivalent sexp with no backquotes +in it. Any backquotes in the sexp are converted them to a +nonbackquoted form. " + (cond + ((atom sexp) sexp) + (t (cons 'quote (backquote-parse-unread sexp))))) + + + +(defun backquote-parse-unread (sexp) + (cond + ;;;((vectorp sexp) + ;;;(error "this backquote parse does not deal with vectors. ")) + ((null sexp) + nil) + ((atom sexp) + sexp) + ((equal (car sexp) 'quote) + (message "Answer is %s" sexp) + sexp) + ((member (car sexp) backquote-symbols) + (backquote-inside-parse (cadr sexp))) + ;; None of them: + (t (cons (backquote-parse-unread (car sexp)) + (backquote-parse-unread (cdr sexp)))))) + + + + + + +(defun backquote-inside-parse (sexp) + (cond + ((null sexp) + nil) + ((atom sexp) + (list 'quote sexp)) + ((equal (car sexp) ',) + `(eval ,(backquote-parse-unread (cadr sexp)))) + (t (cons (backquote-inside-parse (car sexp)) + (backquote-inside-parse (cdr sexp)))))) + + + + + + + diff --git a/elisp/erbot/erbc.el b/elisp/erbot/erbc.el new file mode 100644 index 0000000..0c81835 --- /dev/null +++ b/elisp/erbot/erbc.el @@ -0,0 +1,5141 @@ +;;; erbc.el --- Erbot user-interface commands -- see also erbc5.el +;; Time-stamp: <2009-09-26 22:20:39 fledermaus> +;; Copyright © 2002 D. Goel +;; Emacs Lisp Archive entry +;; Filename: erbc.el +;; Package: erbc +;; Author: D. Goel <deego@gnufans.org> +;; Version: 0.0DEV +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot +;; Other files: +;;; erball.el --- Functions on all files. +;;; erbbdb.el --- +;;; erbc.el --- Erbot user-interface commands. +;;; erbc2.el --- mostly: special functions for erbc.el +;;; erbc3.el ---erbot lisp stuff which should be PERSISTENT ACROSS SESSIONS. +;;; erbc4.el --- Russian Roulette +;;; erbc5.el --- continuation of erbc.el +;;; erbc6.el --- fsbot functions contributed by freenode users, +;;; esp. #emacsers. +;;; erbcompat.el --- Erbot GNU Emacs/XEmacs compatibility issues +;;; erbcountry.el +;;; erbc-special.el --- Special/dangerous implementation functions. +;;; erbdata.el --- +;;; erbedit.el --- quicker operator editing of bots' bbdb +;;; erbeng.el --- english +;;; erbforget.el --- Help make the bots forget some TERMS. +;;; erbkarma.el --- +;;; erblisp.el --- +;;; erblog.el --- +;;; erbmsg.el --- memoserv-esque functions for Erbot +;;; erbot.el --- Another robot for ERC. +;;; erbp.el --- NOT FUNCTIONAL personal erbot-interface, stolen from dunnet.el +;;; erbtrain.el --- Train erbot (erbot).. +;;; erbutils.el --- utils +;;; erbwiki.el --- + +(defvar fs-home-page + "http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot") + + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +;; See also: + + + + +(defvar erbc-version "0.0dev") +(defvar fs-version "0.0dev") + + +;;========================================== +;;; Code: + +;; NOTE: stuff like (fs-et) can be passed possibly mischievous +;; code as the first argument... never eval or "set" any +;; "code"... always convert it to a single atom... before setting it.. + + + +(require 'find-func) + +(defgroup erbc nil + "The group erbc" + :group 'applications) + + +(defcustom fs-before-load-hooks nil "" :group 'erbc) +(defcustom fs-after-load-hooks nil "" :group 'erbc) + + + +(defcustom erbn-char "," + "The character which calls the bot. + +in addition to directly addressing it. + +may be different for +different bots. + +Is really a string, but the length of the string should be 1,. +") +(defcustom erbn-char-double (concat erbn-char erbn-char) + "The string which calls the bot from midsentence + +this string should have a length of EXACTLY 2. + +") + + +(run-hooks 'fs-before-load-hooks) + + +;; Real code +(defcustom fs-internal-botito-mode nil + "Mode to turn on more english-like bunny-behavior" + :group 'erbc) + + + +(defvar fs-tgt nil "Tgt visible to the end-user, as well as changeable by them.") +(defvar erbn-tgt nil "Tgt NOT changeable by enduser.") + +(defvar fs-nick "") +(defvar erbn-nick "") + +(defvar erbn-buffer "") + +(defcustom fs-internal-parse-error-p + nil + "Whether to show lispy errors in term descriptions. + +When nil, an error in a lispy description of a term makes to bot +go to an english mode for the term. +When non-nil, we will just display the error. On a channel full of +lisp hackers, we will want to make this t for users' convenience.") + + +(defcustom erbn-shell-command-p nil + "Whether to allow commands that use shell-commands... +Some fsbot commands use shell-commands... shell-commands always mean +possibility of exploits. andn are disabled by default. + +Make this t at your own risk. ") + + +(defcustom fs-internal-questions + '("what" "where" "who" + ;; no please: + ;;"why" + ;;"how" + ) + "" + :group 'erbc) + +(defcustom erbn-google-defaults + '(("#emacs" ("emacs")) + ("#fsbot" ("fsbot"))) + "" :group 'erbc) + + + +(defun erbn-shell-command (&optional command overridep) + "Execute shell-commands when erbn-shell-command-p is true. + +However, if the second argument overridep is non-nil, we use that to +determine whether to execute the command. In that case, we execute +the command only if overridep is a list, whose first entry of that +list is non-nil" + (cond + ((or (and overridep + (listp overridep) + (first overridep)) + erbn-shell-command-p) + (apply 'shell-command command nil)) + (t + (error "The bot-operator has shell commands disabled")))) + + + + + +(defun erbn-shell-command-to-string (&optional command overridep) + "Execute shell-commands when erbn-shell-command-p is true. + +However, if the second argument overridep is non-nil, we use that to +determine whether to execute the command. In that case, we execute +the command only if overridep is a list, whose first entry of that +list is non-nil" + (cond + ((or (and overridep + (listp overridep) + (first overridep)) + erbn-shell-command-p) + (apply 'shell-command-to-string command nil)) + (t + (error "The bot-operator has shell commands disabled")))) + + + + + +(defun fsi-get-google-defaults () + (cadr (assoc fs-tgt erbn-google-defaults))) + +(defvar fsi-prestring "") +;; (make-variable-buffer-local 'fsi-prestring) + + +(defcustom fs-internal-google-level 0 + "75 is a good choice for fsbot. " + :group 'erbc) +(defcustom fs-internal-english-max-matches 20 + "This check is triggerred only when the users' original request didnot +succeed and so we have gone into an english-mode and are searching. +If the number of matches results in 1000, then most likely, the word +was something like i or you and the user was not intending a search. +" + +:group 'erbc) + +(defcustom fs-internal-questions-all + '("what" "where" "who" "why" "how" + "whose" "which" + ) + "" + :group 'erbc) + +(defcustom fs-internal-articles + '("the" "a" "an" "this" "that") + "" + :group 'erbc) + + +(defcustom fs-internal-english-target-regexp + "^$" + "Targets that prefer english.. so erbot will usually go to a +english-mode unless near-exact matches. This shall usually happen on +the few social channels erbot hangs out on. " + :group 'erbc) + +(defcustom fs-internal-query-target-regexp + "^$" + "Targets where erbot will respond to queries like: +Foo ? " + :group 'erbc) + +(defcustom fs-internal-add-nick-weights + '(1 ;; yes + 5 ;;no + ) + "" + :group 'erbc) + + +(defun fsi-correct-entry (name &rest fubar) + "Assumes that name is a string... this downcases strings. Rendering +it fit for database-entry. " + (unless (stringp name) (setq name (format "%s" name))) + ;;(downcase + (let ((newname + (mapconcat 'identity (split-string name) "-"))) + (or (erbbdb-get-exact-name newname) + newname))) + + +(defun fsi-describe-key-briefly (&optional key &rest args) + "Return the function on key..building block for other erbc's.. +If no such function, return the symbol 'unbound. " + + (unless key + (error + "Syntax: , dkb key")) + (when (and (null key) (null args)) + (setq key "")) + (unless (stringp key) + ;; is this safe? what about properties? + (setq key (read-kbd-macro + (mapconcat '(lambda (arg) (format "%s" arg)) + (cons key args) + " ")))) + (let ((res (key-binding key))) + (if res res + 'unbound))) + +;; for now.. +;;(defalias 'fs-describe-key 'fs-describe-key-briefly) + +(defun fsi-where-is-in-map (map &optional fcn) + (let* ((wi (where-is-internal fcn map))) + (mapconcat 'key-description wi ", "))) + +(defun fsi-where-is-gnus-group (&optional fcn) + (require 'gnus) + (unless fcn (error "please supply a function")) + (fs-where-is-in-map gnus-group-mode-map fcn)) + +(defun fsi-where-is-gnus-summary (&optional fcn) + (require 'gnus) + (unless fcn (error "please supply a function")) + (fs-where-is-in-map gnus-summary-mode-map fcn)) +(defun fsi-where-is-message (&optional fcn) + (require 'gnus) + (require 'message) + + (unless fcn (error "please supply a function")) + (fs-where-is-in-map message-mode-map fcn)) + + + +(defun fsi-keyize (key morekeys) + (setq key (read-kbd-macro + (mapconcat '(lambda (arg) (format "%s" arg)) + (cons key morekeys) " ")))) + + +(defun fsi-describe-key-one-line (&optional key &rest args) + "Key, and just one line of function" + (unless key (error "Syntax: , dk \"Key...\"")) + (let* ((fcn (apply 'fs-describe-key-briefly key args)) + (fcns (format "%s" fcn)) + (apr (or (fs-apropos-exact fcns) + "No doc. available. "))) + (concat (format "%s -- %s" + fcns + apr)))) + +(defalias 'fsi-dko 'fs-describe-key-one-line) + +(defalias 'fsi-describe-key 'fs-describe-key-and-function) + +(defun fsi-lookup-key-from-map-internal (&optional map key &rest morekeys) + (unless key (error "No key supplied. ")) + (unless (stringp key) + (setq key (read-kbd-macro + (mapconcat '(lambda (arg) (format "%s" arg)) + (cons key morekeys) " ")))) + (unless (arrayp key) (setq key (format "%s" key))) + (let* ((fcn (lookup-key map key)) + (fcns (format "%s" fcn)) + (apr (or (fs-apropos-exact fcns) + "No doc available. "))) + (concat (format "%s -- %s" fcns apr)))) + +(defun fsi-lookup-key-gnus-group (&optional key &rest args) + (unless key (error "Syntax: , lkgg \"Key...\"")) + (require 'gnus-group) + (apply 'fs-lookup-key-from-map-internal gnus-group-mode-map key args)) + +(defun fsi-lookup-key-gnus-summary (&optional key &rest args) + (unless key (error "Syntax: , lkgg \"Key...\"")) + (require 'gnus) + (apply 'fs-lookup-key-from-map-internal gnus-summary-mode-map key args)) + +(defun fsi-lookup-key-message (&optional key &rest args) + (unless key (error "Syntax: , lkgg \"Key...\"")) + (require 'gnus) + (require 'message) + (apply + 'fs-lookup-key-from-map-internal gnus-message-mode-map key args)) + + + +(defun fsi-apropos-exact (str) + (unless (stringp str) (setq str (format "%s" str))) + (let* ((reg (concat "^" (regexp-quote str) "$")) + (apr (apropos reg)) + (asso (assoc* str apr + :test + (lambda (a b) + (string= (format "%s" a) (format "%s" b))))) + + (val (second asso))) + (if val (format "%s" val) + nil))) + +(defun fsi-describe-key-long (k &rest args) + (let ((f (apply 'fs-describe-key-briefly k args))) + (fs-describe-function-long f))) + +(defun fsi-describe-key-and-function (key &rest args) + "Describe the key KEY. +Optional argument ARGS . If the input arguments are not strings, it +kbds's them first... , so that , df C-x C-c works" + (when (and (null key) (null args)) + (setq key "")) + (unless (stringp key) + (setq key (read-kbd-macro + (mapconcat '(lambda (arg) (format "%s" arg)) + (cons key args) + " ")))) + (let ((b (key-binding key))) + (cond + ((symbolp b) + (or + (ignore-errors (fs-describe-function b)) + (format "Bound to: %s" b))) + (t + (format "Bound to: %s" b))))) + + + +(defun fsi-describe-function (&optional function nolimitp &rest fubar) + "Describes the FUNCTION named function. +Also tries an fs- prefix for the function.. +nolimitp has to be eq 'nolimit for the nolimit effect to take place.. +" + (unless function + (error + "Syntax: (describe-function 'name-of-function) or , df 'name")) + (let* ((f function) + g + ) + (when (stringp f) + (setq f (erbn-read f))) + (cond + ((symbolp f) + (progn + (setq + g + (cond + ((fboundp f) f) + (t (erbn-read (concat "fs-" (format "%s" f)))))) + (unless (fboundp g) + (setq g f)) + (let* ((def (symbol-function g))) + (ignore-errors + (if (equal 'autoload (car-safe def)) + (load (second def)))) + ;; this check does nothing now.. need ro + (if (equal nolimitp 'nolimit) + + ;;(let ((fs-limit-lines 8)) + ;;(fs-limit-lines (describe-function g))) + (describe-function g) + (describe-function g)) + + ))) ;; if list, DO NOT wanna eval it--> + (t + "NO function specified")))) + + +(defun fsi-where-is (function &rest args) + "Tells what key the function is on.. + +" + (let* ( + (str0 "") + (str1 "") + (str2 "") + (str3 "") + ) + (cond + ((stringp function) (setq function (erbn-read function))) + (t nil)) + (cond + ((null function) (format "Sorry, %s is not a symbol" function)) + ((symbolp function) + (unless (fboundp function) (setq str0 "Either unbound or.. ")) + (setq str2 + (with-temp-buffer + (where-is function t) + (erbutils-buffer-string))) + (concat str0 str1 str2 str3)) + (t (format "Looks like %s is not a symbol" function))))) + +(defun fsi-describe-function-long (function &rest fubar) + "Similar to describe-function, but does not limit the strings... +Use with caution only in privmsgs please, for may produce long outputs. " + (fs-describe-function function 'nolimit)) + + +(defun fsi-describe-variable-long (variable &rest fubar ) + "Similar to describe-variable, but does not limit strings.." + (fs-describe-variable variable 'nolimit)) + +(defun fsi-describe-variable (&optional variable &rest ignore) + "Describes a VARIABLE.." + (unless variable (error "Syntax: , dv 'variable")) + (let* ((f variable)) + (if (stringp f) + (setq f (erbn-read f))) + (cond + ((symbolp f) + (erbutils-describe-variable f)) + + ;; if list, DO NOT wanna eval it--> + (t + "NO variable specified")))) + +(defalias 'fsi-parse 'fs-lispify) +(defalias 'fsi-parse-english 'fs-lispify) + +(defun fsi-require (feature &rest fubar) + "Make the bot require the feature FEATURE. +So that the command df +or dv works fine..Actually, df knows how to load unloaded features +automatically." + (if (stringp feature) + (setq feature (fsi-read feature))) + (when (or (string-match "/" (format "%s" feature)) + (string-match "\\\\" (format "%s" feature))) + (error "Your safety is VERY important to us, so we avoid loading features containing slashes.")) + (cond + ((symbolp feature) (format "%s" (require feature))) + (t "no feature specified"))) + + +(defvar fs-found-query-p nil + "internal.. should be normally set to nil. +When non nil, means that the msg was not meant to the bot, so the +reply please be abbreviated. ") + +(defvar fs-internal-addressedatlast nil + "internal.. normally nil") + +(defvar fs-internal-original-message "" + "internal") + +(defvar fs-internal-message-sans-bot-name "" + "internal") + +(defvar fs-internal-max-lisp-p nil) + + +(defun fsi-respond-to-query-p (msg) + ;; if it is of the form resolve? the user KNOWS what resolve or + ;; kensanata is, and is not asking for information. So, please don't + ;; respond in such a case. + (not + (member msg (mapcar 'first (fs-channel-members-all))))) + +(defcustom fs-internal-parse-preprocess-message-remove-end-chars + ;; remove trailing ^A's that occur on action strings... + (list 1) + "") + +(defcustom fs-web-page-title-p nil + "Change it to t to enable the erbot to look up the title of urls +posted in a channel. When string, will be matched against target.") + +(defcustom fsi-m8b-p nil + "Change it to t for the magic 8-ball... define m8b then of +course... +When string, will be matched against target. " +) + +(defun fsi-parse-preprocess-message (msg) + (let ((len (length msg))) + (when (and + (> len 0) + (member (aref msg (- len 1)) + fs-internal-parse-preprocess-message-remove-end-chars) + (setq msg (subseq msg 0 -1))))) + msg) + +(defvar erbn-dead-check-p nil + "If non-nil, we will not reply to people who have shot themselves +using mark-dead or russian roulette. These people need to be revived +first. Of course, like any magic, revival sometimes works, and +sometimes doesn't.") + +(defun fsi-lispify (&optional msg proc nick tgt localp + userinfo &rest foo) + "Parse the english MSG into a lisp command. + +If it is an 'is', it should always be the second word .. +viz: we had better use hyphens in the first word.. +MSG is a string.. +Is the main function.. but also available to the user as a command... + +NB: The end-result is always an expression.. and NOT a strign.. + + +Just once in a blue moon, this will, at random, even parse messages +not addressed to it... + +Finally, wanna parse messages whose last item contains erbot.. +Optional argument PROC . +Optional argument NICK . +Optional argument TGT . +Optional argument FOO . + +We will also bind a number of variables, as appropriate, for example, +fs-msg*, fs-lispargs, fs-lispa , fs-lispb... so that these vars can be used +anywhere in the code, or the user-defined parts of the code... + +In the grand scheme of things, these bindings should turn out to be +local, because the parent function calling this function should have +'letted these variables. + +" + ;;(when (stringp msg) + ;; (setq msg (split-string msg))) + ;msg + ;proc + ;nick + ;tgtg + ;foo + (setq fs-internal-original-message msg) + (setq msg (fs-parse-preprocess-message msg)) + (setq fs-msg msg) + (setq fs-msgsansbot msg) + (let* + ( + + + (msg (fs-parse-preprocess-message msg)) + (origmsg msg) + ;;(fs-internal-message-sans-bot-name fs-internal-message-sans-bot-name) + (foundquery nil) + (foundquerydouble nil) + (foundkarma nil) + ;; if t, means either our name was at last, or eevn if at + ;; first, they weren't really addressing us.. + ;;(addressedatlast nil) + (leave-alone-p t) + ;;(fs-nick nick) + bluemoon + ) + (unless (stringp origmsg) + (setq origmsg (format "%s" origmsg))) + (unless msg + (error "Format: %s (parse \"your-english-message\")" erbn-char)) + (unless (stringp msg) + (setq msg (format "%s" msg))) + ;; remove leading spaces.. + (while + (and (> (length msg) 0) + (equal (aref msg + 0) 32)) + (setq msg (substring msg 1))) + + ;; remove trailing spaces.. + (while + (and (> (length msg) 0) + (equal (aref msg (- (length msg) 1)) 32)) + (setq msg (substring msg 0 (- (length msg) 1)))) + + (when (and tgt proc) + (set-buffer (erc-get-buffer tgt proc))) + + (when + (and (stringp msg) + (string-match "\\(++\\|--\\)$" msg) + (<= (length (split-string msg)) 2)) + (setq foundkarma t)) + ;; 2003-11-14 T15:36:38-0500 (Friday) D. Goel + ;; requested by elf: + ;; if double ??, then make it a call to m8b + (when (and + fsi-m8b-p + (if (stringp fsi-m8b-p) + (and (stringp tgt) (string-match fsi-m8b-p tgt)) + t)) + (let (len) + (when (and (stringp msg) + (progn + (setq len (length msg)) t) + (> len 1) + (string= "??" + (substring msg (- len 2) len)) + ;;(or + ;;(string-match + ;;erbot-nick msg) + ;;(string-match (concat "^" erbn-char) msg) + ;;(string-match erbn-char-double msg)) + ) + (setq foundquerydouble t) + (setq msg (concat erbn-char " (m8b)"))))) + + (when (and (stringp msg) + (> (length msg) 0) + ;; ignore trailing ? + (equal (aref msg (- (length msg) 1)) 63)) + (progn + (setq foundquery t) + (setq msg (substring msg 0 (- (length msg) 1))))) + + (setq leave-alone-p t) + (setq bluemoon + (or + ;; responding to a general list conversation.. + (fs-blue-moon) + ;; responding in general.. + (and (equal nick tgt) + (or + (stringp nick) + ;; parse commands --> + (null nick) + ) + ))) + (unless (stringp msg) + (setq msg "")) + + + ;; convert midsentence ,, to parsable sentence. + (let (pos) + (when + (and (not (equal 0 + (string-match erbn-char msg))) + (not + (let ((nickpos (string-match erbot-nick msg))) + (and nickpos + (< nickpos 3)))) + ;; part of and + (setq pos + (string-match erbn-char-double msg))) + (setq msg (substring msg (+ pos 1))) + (when (setq pos (string-match erbn-char-double msg)) + (setq msg (substring msg 0 pos))))) + + ; deal with the leading , or ,, + (when (equal 0 + (string-match erbn-char msg)) + (let ((restmsg (substring msg 1))) + (when (equal 0 (string-match "," restmsg)) + (setq restmsg (substring restmsg 1))) + (setq msg (concat erbot-nick ": " restmsg)))) + + + ;; now we split strings.. + (setq msg (split-string msg)) + (setq fs-msglist msg) + (setq fs-msglistsansbot msg) + (cond + ( (and (first msg) + (let ((pos + (string-match erbot-nick (first msg)))) + (and pos (< pos 1)))) + ;;(or + ;;(erbutils-string= (first msg) erbot-nick) + ;;(erbutils-string= (first msg) (concat erbot-nick ",")) + ;(erbutils-string= (first msg) (concat erbot-nick + ;":"))) + (progn + (unless + (or + (string-match (concat erbot-nick ":") (first msg)) + (string-match (concat erbot-nick ",") (first msg)) + (null (second msg)) + (string-match "^," (second msg)) + (string-match "^:" (second msg))) + (setq fs-internal-addressedatlast t)) + (when (> (length msg) 1) + (setq msg (cdr msg))) + (setq leave-alone-p nil))) + + + ;; if it is a short sentence ending in fsbot.. + ((and (first (last msg)) (string-match erbot-nick (first (last + msg))) + (< (length msg) 5)) + ;; don't want this any more.. since no sense in removing the + ;; last term. Example: Want: what is erbot? to stay that way. + ;;(progn + ;;(setq msg (reverse (cdr (reverse msg))))) + (when leave-alone-p + (setq fs-internal-addressedatlast t)) + (setq leave-alone-p nil)) + + + + ;; this might be dangerous if nick is a small word like "apt".. + ;; this also means :( thagt erbot will intervene when users are + ;; talking about her, but not TO her.. + ;; nah, leave this one out.. + ;;((member erbot-nick msg) + ;; (setq leave-alone-p nil)) + + (bluemoon + (setq leave-alone-p nil))) + + (setq fs-internal-message-sans-bot-name + (mapconcat 'identity msg " ")) + + (when (and + foundquery + ;; if tgt is nil, we are being asked to parse + ;; something.. so cool + tgt + (string-match fs-internal-query-target-regexp tgt)) + ;; if this condition causes the thing to be triggerred, then + ;; setq temporarily, a global variable... so responses are muted + ;; in general.. + (let ((goonp nil) (newmsg msg)) + (cond + ((equal (length msg) 1) + (setq goonp + ;; setq to t only if the content of the msg represents + ;; something the user might be interested in. + (fs-respond-to-query-p (first msg)) + + )) + (t + (setq goonp t) + ;; convert what's to what is + (when (stringp (first newmsg)) + (setq newmsg + (append + (split-string (first newmsg) "'") + (cdr newmsg)))) + (if (and goonp + (member + (erbutils-downcase (first newmsg)) + fs-internal-questions)) + (setq newmsg (cdr newmsg)) + (setq goonp nil)) + (if (and goonp + (member + (erbutils-downcase (first newmsg)) + '("s" "is" "are" + ;;"am" + ))) + (setq newmsg (cdr newmsg)) + (setq goonp nil)) + + ;; remove articles + (if (and goonp + (member + (erbutils-downcase (first newmsg)) + fs-internal-articles)) + (setq newmsg (cdr newmsg))) + (unless (equal (length newmsg) 1) + (setq goonp nil)))) + (when goonp + (when leave-alone-p (setq fs-found-query-p t)) + (setq leave-alone-p nil) + (setq msg (list "(" "describe" + (format "%S" (first newmsg)) + "0" ")" + )) + )) + ) + + ;; Sat Jan 8 12:40:46 EST 2005 (petekaz) + ;; We need to make sure this is the last thing we check + ;; because we don't want to hijack another valid command + ;; with our parsing. I.e. if a user adds a term with an + ;; url included in its note, we don't process that. + (when (and leave-alone-p + fs-web-page-title-p + (if (stringp fs-web-page-title-p) + (and (stringp tgt) + (string-match fs-web-page-title-p tgt)) + t)) + (let* ((case-fold-search t) + (url (some 'erbutils-html-url-p msg))) + (when url + (setq leave-alone-p nil) + (setq msg (list "(" "web-page-title" (format "%S" url) ")"))))) + + ;; (cond + ;; ((equal (length msg) 1) + ;; (when leave-alone-p + ;; (setq fs-found-query-p t)) + ;; (setq msg (cons "describe" msg)) + ;; (setq leave-alone-p nil)) + ;; ((and + ;; (equal (length msg) 3) + ;; (member (erbutils-downcase (first msg)) + ;; fs-internal-questions) + ;; (member (erbutils-downcase (second msg)) + ;; '("is" "are"))) + ;; (setq msg (cons "describe" (cddr msg))) + ;; (when leave-alone-p + ;; (setq fs-found-query-p t)) + ;; (setq leave-alone-p nil)) + ;; ((and + ;; (equal (length msg) 3) + ;; (member (erbutils-downcase (first msg)) + ;; fs-internal-questions) + ;; (member (erbutils-downcase (second msg)) + ;; '("is" "are"))) + ;; (setq msg (cons "describe" (cddr msg))) + ;; (when leave-alone-p + ;; (setq fs-found-query-p t)) + ;; (setq leave-alone-p nil)) + + + ;;)) + + ;; finally, ignore bots/fools.. + (let ((ui (format "%S" userinfo))) + (when + (or + (and erbot-use-whitelist + (stringp nick) + (not (member-if + (lambda (arg) + (string-match arg nick)) + erbot-whitelist-nicks))) + (and (stringp nick) + (member-if + (lambda (arg) + (string-match arg nick)) + erbot-ignore-nicks)) + + (some + 'identity + (mapcar + (lambda (ignorethis) + (string-match ignorethis + ui)) + erbot-ignore-userinfos))) + (setq leave-alone-p t))) + + + (setq fs-msglistsansbot msg) +;;;==================================================== + ;; now do the work.. + (if leave-alone-p + ;; not addressed to us, so return nil and be done.. + nil + ;; else.. viz: go on... + (progn + (erblog-log-target tgt) + (let* (;(found nil) + (newmsglist nil) + (msgstr (erbutils-stringify msg)) + ;(newstrmsg nil) + (lispmsg (erbn-read msgstr) + )) + + + ;; do a dead check + (when erbn-dead-check-p (and (not foundquery) + (erbn-dead-check))) + + + (setq + newmsglist + (cond + + ;; are in a read mode.. + (erbn-read-mode + (fs-botread-feed-internal msgstr)) + + + + ;; look for a valid lisp form, then it just needs to be sandboxed + ((or + (consp lispmsg) + (and fs-internal-max-lisp-p (numberp lispmsg)) + (and fs-internal-max-lisp-p (stringp lispmsg)) + (and (symbolp lispmsg) + (let ((newsym + ;;(intern (format "fs-%S" lispmsg)) + (erblisp-sandbox lispmsg))) + (or + (equal 0 + (string-match "fs-" + (format "%S" lispmsg))) + (and + (boundp newsym) + (not (fboundp newsym))))))) + ;;(erblisp-sandbox-fuzzy lispmsg) + (erblisp-sandbox lispmsg) + ) + + + (fs-dunnet-mode + (fs-dunnet-command msgstr)) + + + ;; call to arbitrary function without parens + ;; prefer this before is etc. so that "how is it going" + ;; resolves properly.. + ((or + ;; fboundp ==> allowing macros as well.. + ;;(fboundp (intern (concat "fs-" (first msg)))) + (fboundp (erblisp-sandbox (intern (first msg)))) + ;;(functionp (intern (concat "fs-" (first msg)))) + (equal 0 (string-match "fs-" (first msg)))) + ;; this works great, except that we would like to quote the + ;; internals... because that is the most commonly used + ;; characteristic.. + ;;`("(" ,@msg ")") + (erblisp-sandbox-full + ;;`( ,(intern (first msg)) ,@(erbutils-quote-list + ;;(mapcar 'intern (cdr msg)))) + ;;(read (cons (intern (first msg)) + ;; (read (list (erbutils-stringify (cdr msg)))))) + (fsi-read (concat "( "(erbutils-stringify msg) " )")))) + + ((equal 0 + (string-match "\\(s\\|r\\)/" (first msg))) + (fs-replace-string-from-english-internal + msg)) + ((equal 0 + (string-match "[0-9]+->" (first msg))) + (fs-rearrange-from-english-internal msg)) + ( + (and + + + (or (erbutils-string= (second msg) "is" t) + (erbutils-string= (second msg) "are" t) + ;;(erbutils-string= (second msg) "am" t) + + ) + (member (erbutils-downcase (first msg)) + fs-internal-questions-all + )) + + + ;;`(apply 'fs-describe ',(cddr msg)) + `(funcall 'fs-describe + ',(third msg) + nil nil nil ,"origmsg" + ) + + ) + + ;; some english constructs first... + + ;; search removed---because: is a functionp... + ;;((erbutils-string= (first msg) "search") + ;; (setq newmsglist + ;; `("(" "search" ,@(cdr msg) ")"))) + ((and + + ;; do not want to take such cases, 100% are annoying + ;; false matches. + (not fs-internal-addressedatlast) + + (or + (erbutils-string= (second msg) "is" t) + (erbutils-string= (second msg) "are" t)) + ;;(erbutils-string= (third msg) "also" t) + (member-ignore-case (third msg) + (list "also" "also,")) + ) + (erblisp-sandbox-fuzzy + `( + fs-set-also ,(first msg) + ;;,@(erbutils-quote-list (cdddr msg)) + ,(erbutils-stringify (cdddr msg)) + ))) + ((and (erbutils-string= (first msg) "tell") + (erbutils-string= (third msg) "about")) + `(fs-tell-to + ,(erbutils-stringify (cdddr msg)) + ,(format "%s" + (second + msg)) + )) + + ( + (and + ;; do not want to take such cases, 100% are annoying + ;; false matches. + (not fs-internal-addressedatlast) + + (or (erbutils-string= (second msg) "is") + (erbutils-string= (second msg) "are"))) + (erblisp-sandbox-fuzzy + `(fs-set-term + ;; a string.. so we are safe.. + ,(first msg) + ;; another string... so we are safe.. + ,(erbutils-stringify (cddr msg))))) + + + + ((and + (not fs-internal-addressedatlast) + (or + (erbutils-string= (first msg) "no" t) + (erbutils-string= (first msg) "no," t)) + (or + (erbutils-string= (third msg) "is") + (erbutils-string= (third msg) "are") + ) + + ) + (erblisp-sandbox-fuzzy + `(fs-set-force ,(second msg) + ;;,@(erbutils-quote-list (cdddr msg)))) + ,(erbutils-stringify (cdddr msg)))) + ) + + ((let ((foo (first msg))) + (and + (not fs-internal-addressedatlast) + (<= (length msg) 2) + (string-match "\\(++\\|--\\)$" foo) + (not (fs-notes foo + )))) + (let* ((foo (first msg)) + (sec (second msg)) + (bar (substring foo 0 -2)) + (plusp (string-match "++$" foo))) + (if plusp + `(fs-karma-increase ,bar ,sec) + `(fs-karma-decrease ,bar ,sec)))) + ((or fs-internal-addressedatlast + (and fs-internal-botito-mode (> (length msg) 3))) + `(funcall 'fs-english-only ,origmsg ,fs-internal-addressedatlast)) + + (t + ;;`(apply 'fs-describe ',msg) + + ;;`(funcall 'fs-describe ',(first msg) + ;; ',(second msg) + ;; ',(third msg) + ;; nil + ;; ,origmsg + ;; ) + `(funcall 'fs-describe-from-english + ,origmsg + ',msg) + + + + + + ) + )) + ;; this should be "%S" and not "%s" the lattwer will convert + ;; (dk "k") into (dk k) + (format "%S" newmsglist)))))) + + +(defun fsi-describe-from-english (&optional origmsg msg) + "Call fs-describe appropriately. +ORIGMSG is in english. +MSG is a list.. + +Plan + +For multiple words, commence a search foo.*bar.*baz IF WE KNOW THAT +SEARCH or SEARCH--WIDE WILL SUCCEED, which will then, of course, go to +search-wide if it fails. + +Else, of course, do the usual thing: viz. call describe... + + +" + (unless (and origmsg msg) + (error "Are you a user trying to call this function? Perhaps just use +'describe instead :). Anyway, this function needs 2 arguments. ")) + (let ((len (length msg)) + mainterm firstterm remainder N M prestring expr tmpv + (searchp nil) + (multitermp nil) + (fs-internal-google-level fs-internal-google-level) + ) + (cond + ((<= len 1) + (if (fsi-notes (first msg)) + (fs-describe + (first msg) + nil nil nil origmsg) + (fs-describe + (fsi-generalize-search-term (first msg)) + nil nil nil origmsg))) + (t + (setq mainterm (first msg)) + (setq firstterm mainterm) + (setq remainder (cdr msg)) + (while + (and + remainder + (progn + (setq tmpv (first remainder)) + (and (not (integerp tmpv)) + (progn + (unless (stringp tmpv) (setq tmpv (format "%s" + tmpv))) + (not (integerp (ignore-errors (erbn-read tmpv)))))))) + ;;(setq searchp t) + (setq mainterm + (concat mainterm ".*" tmpv)) + (setq multitermp t) + (pop remainder)) + ;; why is this true only for multitermp??? + ;; Ah, because we say: if you end up searching and there are + ;; multiple terms, you might as well include a result from + ;; google among the search results. + (when multitermp + (setq fs-internal-google-level (+ fs-internal-google-level 25))) + + (when (and multitermp + ;; viz. if it will work + (second (fs-search-basic + mainterm nil nil 'describe))) + (setq searchp t)) + + + (if searchp + (fs-search + mainterm (first remainder) (second remainder) + "Try: " origmsg) + (fs-describe + (fsi-generalize-search-term firstterm) (first remainder) (second remainder) + (third remainder) origmsg)))))) + + +(defun fsi-generalize-search-term (term) + (erbutils-replace-string-in-string "-" "[ -]*" term)) + +;; (defalias 'fs-hello 'fs-hi) +;; (defalias 'fs-hey 'fs-hi) + +(defalias 'fs-thanks 'fs-thank) +(defun fs-thank (&rest args) + (let ((aa (erbutils-random '("no problem" "you are welcome" + + )))) + (eval + (erbutils-random + '( + (concat aa erbn-char " " fs-nick) + (concat fs-nick erbn-char " " aa)))))) + +(defun fs-greet (&optional nick &rest args) + ". + Optional argument NICK . + Optional argument ARGS ." + (if (and nick (not (string-match erbot-nick (format "%s" nick)))) + (format "hi %s !!" + (let ((foo (split-string (format "%s" nick ) + "[^a-bA-Z0-0]"))) + (or (first foo) nick)) + ) + (fs-describe "hi"))) + +;;; (defun fs-ni (&optional nick &rest args) +;;; ". +;;; Optional argument NICK . +;;; Optional argument ARGS ." +;;; (if (and nick (not (string-match erbot-nick (format "%s" nick)))) +;;; (format "NI %s !!" +;;; (let ((foo (split-string (format "%s" nick ) +;;; "[^a-bA-Z0-0]"))) +;;; (or (first foo) nick)) +;;; ) +;;; (fs-describe "hi"))) + +;;; (defun fs-greet (&optional nick &rest foo) +;;; "Nada..just a call to `fs-hi'. +;;; Optional argument NICK ." +;;; (fs-hi nick)) + +(defun fs-kiss (&optional nick &rest foo) + "Nada. +Optional argument NICK ." + (setq nick (format "%s" (or nick "itself"))) + (cond + ((member nick (list erbot-nick "yourself" "self")) + (eval + (erbutils-random + '("I'd rather kiss you" + "Kiss myself? Why?")))) + (t + (eval + (erbutils-random + '((format "/me kisses %s" nick) + (format "/me gives %s a big smooch" nick) + (format "/me runs in the other direction, shouting NEVER!!"))))))) + +(defun fs-hug (&optional nick) + (unless nick (setq nick "itself")) + (setq nick (format "%s" nick)) + (cond + ((member nick (list erbot-nick "yourself" "self")) + (eval + (erbutils-random + '("But i do that all the time. " + "Hug myself? Why?")))) + (t + (eval + (erbutils-random + '((format "/me gives %s a tight hug" nick) + (format "/me clings to %s" nick) + (format "/me runs in the other direction, shouting NEVER!!") + (format "/me grabs hold of %s and vows to never let go" nick) + (format "/me grabs hold of %s and vows to never let go" nick))))))) + + + + +(defun fs-love (&optional nick &rest bar) + ". +Optional argument NICK ." + + + (let ((nonep nil)) + (unless nick (setq nick "someone sexy") (setq nonep t)) + (setq nick (format "%s" nick)) + (cond + ((and (not nonep) (member nick (list "you" "me"))) + (erbutils-random + '("Thank you. Enjoyed that. " + "Thanks, I love you even more now. " + "Wouldn't that amount to interspecies sex? " + "Sex between humans and machines is not known to produce +anything useful. "))) + ((member nick + (list erbot-nick "yourself" "self")) + (erbutils-random + '("This is a complicated operation. Can't (yet) perform operation on self. " + "Please train me on this maneuver. "))) + (t + (eval + (erbutils-random + '((format "/me goes with %s to a private place..." nick) + (format "/me looks at %s and yells \"NEVER!\"" nick) + (format "/me looks at %s lustfully" nick)))))))) + +(defalias 'fs-fuck 'fs-love) + +(defvar fs-flame-target nil) + + + +(defun fsi-eval-or-say (str &optional fs-victim) + (let ((aa (when (stringp str) + (ignore-errors (erbn-read str))))) + (cond + ((consp aa) + (unless fs-victim (setq fs-victim fs-nick)) + (fsi-eval aa)) + (fs-victim + (format "%s: %s" fs-victim str)) + (t + (format "%s" str))))) + + + + + + +(defun fs-flame (&rest args) + "" + (let ((flames (ignore-errors (fs-notes "flames"))) + fs-flame-target num) + (cond ((and (numberp (cadr args)) + (not (cddr args))) + (setq fs-flame-target (car args) + num (cadr args))) + ((consp (cdr args)) + (setq fs-flame-target (mapconcat (lambda (arg) + (format "%s" arg)) + args " "))) + ((car args) + (setq fs-flame-target (format "%s" (car args)))) + (t (setq fs-flame-target (format "%s" erbot-end-user-nick)))) + (if (string= (format "%s" fs-flame-target) "me") + (setq fs-flame-target erbot-end-user-nick)) + ;; Check for flame.el support + (cond + ((and (consp flames) (> (length flames) 0)) + (fsi-eval-or-say + (if num + (nth num flames) + (fs-random-choose flames)) + fs-flame-target)) + (t (fs-flame-mild fs-flame-target))))) + + + + + + +(defun fs-flame-mild (&rest args) + "Doesn't really flame right now.. +Optional argument ARGS ." + (let ((target + (if (first args) + (format "%s" (first args)) + erbot-end-user-nick))) + (if (string= (format "%s" target) "me") + (setq target erbot-end-user-nick)) + ;; Check for flame.el support + (if (featurep 'flame) + (eval + (erbutils-random + '( + (format (erbutils-random erbdata-flames) + target target target) + (concat target ": " (flame-string))) + '(1 30))) + (format (erbutils-random erbdata-flames) + target target target)))) + +;; remove kill +;(defun fs-kill (&optional nick &rest nicks) +; ". +;Optional argument NICK . +;Optional argument NICKS ." +; (format "/me , trained by apt, chops %s into half with an AOL CD" nick));; + +;(defun fs-quote (&rest args) +; (quote args)) + +(defun fs-bye (&rest msg) + "" + (erbutils-random + '("Okay, see you later" + "later" + "Bye then" + "Take care now" + "Happy hacking"))) + + +;;; (defun fs-help (&rest args) +;;; "Introductiry help. " +;;; (let ((fir (first args))) +;;; (if (stringp fir) +;;; (setq fir (intern fir))) +;;; (unless (symbolp fir) (setq fir 'dummy-no-help)) +;;; (if (null fir) +;;; "I try to understand English, though lisp is the real way to go. Here are some interesting topics: quickstart, example, future-features, help about, help commands, help data, help english, help name, help homepage, +;;; help owner, help specs, help parse \(for lisp stuff\), describe help, describe suggest , help parse-web , help functionality +;;; " +;;; (cond +;;; ((equal fir 'about) +;;; (fs-help 'name)) +;;; ((equal fir 'owner) +;;; (fs-help 'data)) + +;;; ((equal fir 'name) +;;; "I am erbot: The Free Software Bot, using ERC in emacs.. +;;; I can also be addressed by , .. yeah, a comma .. +;;; The real way to address me is erbot: (lisp-command..) .. all this +;;; english is just candy-interface... ") +;;; ((equal fir 'specs) +;;; "/sv") +;;; ((equal fir 'address) +;;; (fs-help 'name)) +;;; ((equal fir 'homepage) +;;; "homepage: http://deego.gnufans.org/~deego/pub/emacspub/lisp-mine/erbot/ +;;; Data: http://deego.gnufans.org/~erbot/data/ +;;; Suggestions to D. Goel: deego@gnufans.org") +;;; ((equal fir 'code) +;;; (fs-help 'homepage)) +;;; ((equal fir 'data) +;;; (fs-help 'homepage)) +;;; ((equal fir 'suggestions) +;;; "Add stuff to keyword suggest, also see help homepage") +;;; ((equal fir 'english) +;;; "Some common syntaxes: , foo is bar; , foo is also bar; +;;; , no foo is bar; , forget foo ; , flame nick; , doctor ; etc.") +;;; ((equal fir 'parse) +;;; "Try the command , parse \", <english-message>\" to see the +;;; lisp renditions of your english messages") +;;; ((equal fir 'parse-web) +;;; "Ask me to parse a (please: USEFUL PAGE) webpage and a label +;;; and i will do so in my free time and gain knowledege... under +;;; construction.. ") +;;; ((equal fir 'functionality) +;;; "Bulk of the info is stored as assoc-list data (see +;;; homepage). You generally type foo and the corresp. data is +;;; returned.. you can also (search ... )") +;;; ((equal fir 'commands) +;;; " You can use both lisp and english to communicate.. +;;; Type , (commands) to get a list of commands..") + +;;; ((equal fir 'suggest) +;;; "Add your suggestions to the field \"suggestions\", or contact the author") + + +;;; (t "select an option or Type , help for a list of options.." +;;; ))))) + + + + + + +(defun fsi-command-list (&rest foo) + "Used by erbc.el and by erbot-install.. " + (erbn-command-list-from-prefix "fs-")) + + +(defun fsi-command-list-readonly (&rest foo) + "Used by erbc.el.. and erbot-install " + (erbn-command-list-from-prefix "fsi-")) + + +(defun erbn-command-list-from-prefix (prefix &rest foo) + "Used by erbc.el.. should return a string.." + (let* + ((longnames (erbutils-matching-functions prefix)) + (shortnames + (with-temp-buffer + (insert (format "%s" longnames)) + (goto-char (point-min)) + (replace-string prefix "") + (text-mode) + (fill-paragraph 1) + (erbn-read (buffer-substring (point-min) (point-max)))))) + shortnames)) + +(defun fsi-commands (&optional regexp N M &rest foo) + "List available commands matching REGEXP. If N and M provided, list +matches starting at N and ending at M. " + (if (and regexp (not (stringp regexp))) + (setq regexp (format "%s" regexp))) + (let* ((all-commands (fs-command-list)) + (pruned-commands + (if (stringp regexp) + (mapcon + '(lambda (arg) + (if (string-match regexp (format "%s" (car arg))) + (list (car arg)) nil)) + all-commands) + all-commands)) + (len (length pruned-commands)) + final-commands + (str0 "") + (str1 "") + (str2 "") + (str3 "") + (str4 "")) + (setq str0 (format "%s matches. " len)) + (unless (or (< len 20) (and (integerp N) (> N 0))) + (setq str1 + "Perhaps type , df commands for general syntax. ")) + (unless (integerp N) (setq N 0)) + (unless (integerp M) (setq M len)) + (if (= M N) (setq M (+ N 1))) + (when (> M len) (setq M len)) + (if (> N 0) (setq str2 (format "Matches starting at %s -->" N))) + (setq final-commands (subseq pruned-commands N M)) + (setq str3 + (format "%s" final-commands)) + (concat str0 str1 str2 str3))) + + + +(defun fsi-describe-commands (&rest foo) + "Just a help command. Describes how to run commands. " + (concat + "If you use plain english, it simply gets transformed to lisp +commands.. main/default command: (describe).. to see transformation, +use (parse). See also fs-commands. + +PS: no naughty ideas please :)--- the commands are sandboxed via an +fs- prefix.. + +Future commands: info-search, hurd-info-search etc. etc. +" +)) + + +(defalias 'fsi-d 'fs-describe) + + +(defun fsi-search (&optional regexp N M prestring expr &rest rest) + "Search for the REGEXP from among all the terms (and their +descriptions). See also fs-search-wide. +EXPR (optional) is the full initial expression.. " + (unless regexp + (error "Syntax: , s REGEXP &optional N M")) + (let* ((len-results (apply 'fs-search-basic regexp N M nil + rest)) + (len (first len-results)) + (results (second len-results)) + (str0 " ") + (str1 "") + (str2 "") + (str3 "") + (str4 "") + (str5 "") + ) + (when (and (> len 100) (not prestring)) + (setq str0 (format " Use , s REGEXP N M to limit results. "))) + (when (and (< len 5) (not prestring)) + (setq str0 (format " Perhaps try also , sw %s . " regexp))) + (unless prestring (setq str1 (format "%s match(es). " len))) + (if (and (integerp N) (> N 0) (not prestring)) + (setq str2 (format "Matches starting at %s\n" N))) + (unless prestring (setq str3 "--> ")) + (setq str4 + (mapconcat 'identity + results " " + ) + + ) + (when (and (> fs-internal-google-level 80) (> len 1)) + (setq str5 + (let ((foo (fs-google-lucky-raw + fs-internal-message-sans-bot-name))) + (if foo (concat " " foo) str5)))) + (cond + ((and prestring (= len 1)) + (fs-describe (first results))) + ((and (> len 0) + (or + (not prestring) + (< len fs-internal-english-max-matches))) + (unless (stringp prestring) + (setq prestring "")) + (concat prestring str0 str1 str2 str3 str4 str5)) + (t (apply 'fs-search-wide regexp N M + "Try: " + (or expr fs-internal-original-message) + rest))))) + + +(defun fsi-search-wide-sensitive (&rest args) + "Like fs-search-wide, but case-sensitive" + (let ((case-fold-search nil) + (bbdb-case-fold-search nil)) + (apply 'fs-search-wide args))) + + + + + + + + +(defun fsi-search-wide (&optional regexp N M prestring expr &rest rest) + "Search for the REGEXP from among all the terms (and their +descriptions). See also fs-search-wide. +EXPR is the full initial expression, well, mostly.. +" + (let* ((len-results (apply 'fs-search-basic regexp N M 'describe + rest)) + (len (first len-results)) + (results (second len-results)) + (str0 "") + (str1 "") + (str2 "") + (str3 "") + (str4 "") + (str5 "") + ) + (when (and (> len fs-internal-english-max-matches) (not prestring)) + (setq str0 (format "Perhaps try also , s %s . " regexp))) + (unless prestring (setq str1 (format "%s match(es). " len))) + (if (and (integerp N) (> N 0) (not prestring)) + (setq str2 (format "Matches starting at %s\n" N))) + (unless prestring (setq str3 "--> ")) + (setq str4 + ;;(format "%s" results) + (mapconcat 'identity results " ") + ) + (when (and (> fs-internal-google-level 80) (> len 1)) + (setq str5 + (let ((foo (apply 'fs-google-lucky-raw + fs-internal-message-sans-bot-name + (fs-get-google-defaults) + ))) + + (if foo (concat " " foo) str5)))) + + ;; why does this not work as expeecteD? adding a nil for now: + (when (and prestring (>= len fs-internal-english-max-matches)) + (setq fsi-prestring + (concat fsi-prestring + "[Too many DB matches] "))) + (cond + ((and prestring (= len 1)) + (fs-describe (first results))) + ((and (> len 0) + (or (not prestring) + (< len fs-internal-english-max-matches))) + (unless (stringp prestring) + (setq prestring "")) + (concat prestring str0 str1 str2 str3 str4 str5)) + (t + (fs-english-only (or expr fs-internal-original-message) + nil + ))))) + + +(defcustom erbn-greeting-string + "Greetings and Salutations from %s" "") + + +(defun fsi-english-only (expr &optional addressedatlast nogoogle) + "when addressedatlast is t, means that fsbot/botito was triggered because +it was addressed at last. " + ;; expr should already be a string ...but just in case: + (unless expr (setq expr fs-internal-original-message)) + (setq expr (erbutils-downcase (erbutils-stringify expr + + ))) + (let ((exprlist (split-string expr + ;;"[ \f\t\n\r\v]+" + "[^a-zA-Z0-9]" + )) + (gotit nil) + ans len + ) + (setq exprlist (remove "" exprlist)) + (setq len (length exprlist)) + (cond + ((or + + (and (= len 1) + (string-match erbot-nick (first exprlist)))) + (setq gotit t + ans + (format erbn-greeting-string + erbot-nick))) + ((or + (member "hi" exprlist) + (member "hello" exprlist) + (member "yo" exprlist)) + (setq + gotit + t + ans + (concat + (erbutils-random + '("hi " "hello " "hey " "hei ")) + (erbutils-random + '("sexy! " "!!" "there" ""))))) + + ((member "bye" exprlist) + (setq gotit t + ans + (erbutils-random + '("Later" "See ya" "Bye then" "Bye")))) + ((or + (member "welcome" exprlist) + (member "weclome" exprlist)) + (setq gotit t + ans + (erbutils-random + '(":-)" "How goes?" "Hello!" + "Greetings!" + "How is it going?" + "This is my favorite channel!" + "I love this place. " + "Thanks. I love it here.")))) + + ((or + (member "tnx" exprlist) + (member "tnks" exprlist) + (member "thanks" exprlist) + (member "thanku" exprlist) + (member "thankyou" exprlist) + (and (string-match "thank" expr) + (or + (string-match "you" expr) + (string-match erbot-nick expr)) + (string-match "thank you" expr))) + (setq gotit t + ans + (erbutils-random + '("No problem" "Welcome!" "You're welcome" + "no problemo" + "Sure!" + "(:" + "Cool." + + )))) + + ((or (member "thx" exprlist) + (member "thankx" exprlist) + (member "thanx" exprlist) + ) + (setq gotit t + ans + (erbutils-random + '("np" "urw" "hehe, np" )))) + ((or (string-match "wassup" expr) + (string-match "what's up" expr)) + (setq gotit t + ans + (concat + (erbutils-random + '("Nothing much. " "Just, you know. " + "Just the usual..")) + (erbutils-random + '("And you? " "How about you? " + "How goes with you? " + "What have you been up to?"))))) + ( + (or + (string-match "love" expr) + (string-match "like" expr)) + (setq gotit t + ans + (format "%s loves you!" erbot-nick))) + ( + (or + (string-match "hate" expr) + (string-match "dislike" expr) + (string-match "don't like" expr)) + (setq gotit t + ans + (format "%s only has love for you!" erbot-nick))) + + ((string-match "help" expr) + (setq gotit t + ans (format "Type , help"))) + ((or (member "bot" exprlist) + (member "robot" exprlist)) + (setq gotit t + ans + (concat + (erbutils-random + '( + "I am just an ordinary human" + "I am an organic" + "Why? Do you speak lisp?" + "Why? Do you have a lisp?" + "I am human. Are you a bot?" + "I am human. Are you a robot?" + "I am not a bot" + "Fine, say what you like" + "Bots should have rights too, not that I am one" + "Are you a bot-rights abuser?" + "I am a human. You?" + "YEAH!! I AM A GIANT ROBOT!")) + (erbutils-random + '("" "!")) + (erbutils-random + '("" " :)" " :(" " ;)" " :D" " heh"))))) + + + ) + + (if gotit ans + (if (and addressedatlast (not fs-internal-botito-mode)) + 'noreply + ;;(cond ((> rand fs-internal-doctor-rarity) + (if (and (> fs-internal-google-level 50) (not nogoogle)) + (apply 'fs-google-from-english fs-internal-message-sans-bot-name + (fs-get-google-defaults) + ) + (funcall 'fs-do-weighted-random (erbutils-stringify + expr + ))))))) +;;(t (apply 'fs-suggest-describe expr))))))) + +(defun fsi-eval (expr) + (eval + (erblisp-sandbox expr))) + + + +;;; (defmacro fs-apply (&optional msymbol &rest mexprs) +;;; (cond +;;; ((and (listp msymbol) +;;; (not (equal (first msymbol) "quote"))) +;;; (error "unquoted list")) +;;; ((and (symbolp msymbol) +;;; (not (equal 0 +;;; (string-match "fs-" +;;; (format "%s" msymbol))))) +;;; (setq msymbol (intern (format "fs-%s" msymbol)))) +;;; (t "Funcalling foo is really bar!")) +;;; `(erbnocmd-apply ,msymbol ,@mexprs)) + + + + +;;; (cond +;;; ((null mexprs) +;;; `(fs-funcall ,msymbol ,mexprs)) +;;; (t +;;; (let ((erbnocmd-tmpvar (length mexprs))) +;;; `(fs-funcall +;;; ,msymbol +;;; ,@(subseq mexprs 0 (- erbnocmd-tmpvar 1)) +;;; ,@(erblisp-sandbox-quoted (first (last mexprs)))))) +;;; )) + + +;;; (defmacro fs-funcall (&optional msymbol &rest mexprs) +;;; "This makes sure that if the first argument to fs- was a +;;; variable instead of a symbol, that variable does not get evaluated, +;;; unless it begins in fs-, or that variable gets converted to fs-." +;;; (when +;;; (listp msymbol) +;;; (setq msymbol +;;; (erblisp-sandbox-quoted msymbol)) +;;; (when (equal (first msymbol) 'quote) +;;; (setq msymbol (cdr msymbol)))) +;;; (when +;;; (and (symbolp msymbol) +;;; (not (equal 0 +;;; (string-match "fs-" +;;; (format "%s" msymbol))))) +;;; (setq msymbol (intern (format "fs-%s" msymbol)))) +;;; (unless +;;; (or (listp msymbol) (symbolp msymbol)) +;;; (error "Macros confuse this bot!")) +;;; `(erbnocmd-funcall ,msymbol ,@mexprs)) + + +;;; (defun erbnocmd-funcall (&optional symbol &rest exprs) +;;; (let (erbnocmd-ss ) +;;; (unless +;;; (or (symbolp symbol) +;;; (listp symbol)) +;;; (error "Syntax: (funcall SYMBOL &rest arguments)")) +;;; (unless +;;; (functionp symbol) +;;; (error "Even smart bots like me can't funcall nonfunctions. ")) +;;; (setq erbnocmd-ss (erblisp-sandbox-quoted symbol)) +;;; (when (listp erbnocmd-ss) +;;; (when (equal (first erbnocmd-ss) 'quote) +;;; (setq erbnocmd-ss (cadr erbnocmd-ss))) +;;; (unless (listp erbnocmd-ss) (error "no lambda in quote")) +;;; (unless (member (first erbnocmd-ss) '(fs-lambda lambda)) +;;; (error "Lambda unmember")) +;;; (when (equal (first erbnocmd-ss) 'fs-lambda) +;;; (setq erbnocmd-ss (cons 'lambda (cdr erbnocmd-ss))))) +;;; (cond +;;; ((null erbnocmd-apply-p) +;;; (erbnocmd-apply-basic +;;; erbnocmd-ss +;;; exprs)) +;;; ;; wanna apply +;;; (t +;;; (let ((len (length exprs))) +;;; (erbnocmd-apply-basic +;;; erbnocmd-ss +;;; (append +;;; (subseq exprs 0 (- len 1)) +;;; (first (last exprs))))))))) + + + +;;; (defun erbnocmd-apply-basic (fcn &rest args) +;;; (cond +;;; ((functionp fcn) +;;; (apply fcn args)) +;;; (t +;;; (fs-apply +;;; (erbnocmd-user-fcn-definition +;;; fcn) +;;; args)))) + +;;; ;;; (defun erbnocmd-apply (&optional symbol &rest args) +;;; ;;; (if (null args) +;;; ;;; (erbnocmd-funcall symbol) +;;; ;;; (let* ((rev (reverse args)) +;;; ;;; (fir (first rev)) +;;; ;;; (args1 (reverse (rest rev)))) +;;; ;;; (apply +;;; ;;; 'erbnocmd-funcall +;;; ;;; symbol +;;; ;;; (append +;;; ;;; (mapcar 'erblisp-sandbox-fuzzy +;;; ;;; args1) +;;; ;;; (mapcar 'erblisp-sandbox-fuzzy +;;; ;;; fir)))))) + + + +(defun fsi-search-basic (&optional regexp N M describep &rest rest) + "Don't call directly.. meant as a building block for other functions. + Search for the REGEXP from among all the terms (and their + descriptions). See also fs-search-wide. That function actually + calls this function with describep set to 'describe. + + Returns (len list-of-pruned-results). Len is the total number of + results. + + When describep is non-nil, search the whole bbdb, not just names.. " + (unless regexp + (error "Syntax: , sw regexp &optional N M")) + (let* ((bar (cons regexp (cons N rest))) + (foo (if (stringp regexp) regexp + (if regexp (format "%s" regexp) + "^$"))) + (barbar + (append + (and regexp (list regexp)) + (and N (list N)) + (and M (list M)) + (and describep (list describep)) + rest)) + (regexp-notes + (if (equal describep 'describe) + foo nil)) + records results + ) + + (if (stringp N) + (setq N (erbn-read N))) + (unless (integerp N) + (setq N 0)) + (if (stringp M) + (setq M (erbn-read M))) + (if (and (integerp M) (= M N)) + (setq M (+ N 1))) + (setq records + (if (equal describep 'describe) + (bbdb-search (bbdb-records) + foo nil nil foo) + (bbdb-search (bbdb-records) foo))) + + (setq results (mapcar '(lambda (arg) (aref arg 0)) records)) + (let ((len (length results))) + (unless (and (integerp M) (< M len)) + (setq M len)) + (list len (subseq results N M))))) + + +(defvar fs-internal-describe-literally-p nil) + + + + +(defvar fs-msg "The exact current message being parsed. ") +(defvar fs-msglist "Message broken into list. This list may have +removed characters like ? and ,, No guarantees here. See +fs-msgsandbot instead.") +(defvar fs-msgsansbot nil "Current message being parsed, but the +invocation part removed. ") + +(defvar fs-msglistsansbot nil + "Message broken into list, invocation parts removed. + +.. with the invokation parts, like ,, or , or fsbot:, removed. Thus, +if message taken from the middle of a sentence, then this is the list +from only that part. ") + + + + +(defvar fs-lispargs nil + "Will be used when using the lisp form") + + + +(defvar fs-lispa nil + "Will be used when using the lisp form") + + +(defvar fs-lispb nil + "Will be used when using the lisp form") + + +(defvar fs-lispc nil + "Will be used when using the lisp form") + +(defvar fs-lispd nil + "Will be used when using the lisp form") + +(defvar fs-lispe nil + "Will be used when using the lisp form") + + + +(defun fsi-describe-literally (&rest rest) + (unless rest + (error "Format: , describe-literally TERM [FROM] [TO]")) + (let ((fs-internal-describe-literally-p t) + (fir (first rest)) + (res (rest rest))) + (cond + (fir + (apply 'fs-describe + (if (stringp fir) (regexp-quote fir) + (regexp-quote (format "%s" fir))) + res)) + (t (apply 'fs-describe rest))))) + + +(defvar erbnocmd-describe-search-p t) + +(defun fsi-describe (&optional mainterm N M prestring expr &rest rest) + "The general syntax is (fs-describe TERM [N] [M]). +Looks for TERM, and shows its descriptions starting at description +number N, and ending at M-1. The first record is numbered 0. +" + (let + ;;((fs-lispargs (append (list mainterm N M prestring expr) rest))) + ;; nothing, just a let not used any more.. + ((fs-nothingsorry nil)) + ;; in the global scheme of things, this will turn out to be only a + ;; local binding, since erbeng-main will have (let)'ed this. Same + ;; for fs-lispa , fs-lispb, fs-lispc... + + (setq fs-lispargs (mapcar 'fsi-read-or-orig (cdr fs-msglistsansbot))) + (when fs-found-query-p + (setq N 0) + (setq M 1)) + (unless prestring (setq prestring "")) + (unless mainterm + (error + "Format , (describe TERM &optional number1 number2)")) + (let* ((bar (cons mainterm (cons N rest))) + (foo (format "%s" mainterm)) + (barbar + (append + (and mainterm (list mainterm)) + (and N (list N)) + (and M (list M)) + rest)) + + ) + (setq foo (fs-correct-entry foo)) + (if (stringp N) + (setq N (erbn-read N))) + (unless (integerp N) + (setq N 0)) + (if (stringp M) + (setq M (erbn-read M))) + (if (and (integerp M) (= M N)) + (setq M (+ N 1))) + (unless (stringp foo) + (setq foo (format "%s" foo))) + (let* ((result0 + (erbbdb-get-exact-notes + foo + )) + (result1 (and (stringp result0) + (ignore-errors (erbn-read result0)))) + (len (length result1)) + (newM (if (and (integerp M) + (< M len)) + M len)) + (result (subseq result1 N newM)) + (shortenedp (or (< newM len) + (> N 0))) + ) + + + (cond + ;; in cond0 + (result1 + (let* ( + ;; notice the use of result1 here, not result. + (aa (first result1)) + (aarest (cdr result1)) + (bb (split-string aa)) + + (cc (first bb)) + (dd (second bb)) + (ddd (or (and (stringp dd) (regexp-quote dd)) "")) + (ee (cdr bb)) + (expandp + (and + (not fs-internal-describe-literally-p) + + ;;(equal len 1) + )) + + ) + + (if (and + (equal cc "directonly") + ;;(equal len 1) + ) + ;; hmm this if part still doesn't take care of aa.. + (if fs-found-query-p + (progn + (setq aa "lisp 'noreply") + (setq bb (split-string aa)) + (setq cc (first bb)) + (setq dd (second bb)) + (setq dd (or (and (stringp dd) (regexp-quote dd)) "")) + (setq ee (cdr bb))) + (when expandp + (progn + (setq bb (cdr bb)) + (setq aa (mapconcat 'identity bb " ")) + (setq result1 (cons aa aarest)) + (setq result (subseq result1 N newM)) + (setq cc (first bb)) + (setq dd (second bb)) + (setq ddd (or (and (stringp dd) + (regexp-quote dd)) "")) + (setq ee (cdr bb)))) + + + + )) + (cond + ((and expandp + (erbutils-string= cc "redirect") + ;; do not redirect, when term had multiple + ;; entries: + (not aarest) + dd) + (apply 'fs-describe ddd + N M + (format "[->] " + ) + rest)) + ((and expandp (member cc '("unecho" "noecho")) + dd) + ;;dd) + (erbutils-itemize + (cons + (format "%s" + (mapconcat 'identity ee " ")) + (cdr result)) + N + shortenedp + )) + ((and expandp (member cc '("lisp"))) + (let* + ((fs-nothingsorry nil)) + ;; (fs-lispargs fs-lispargs) ;; no need + (setq fs-lispa (nth 0 fs-lispargs)) + (setq fs-lispb (nth 1 fs-lispargs)) + (setq fs-lispc (nth 2 fs-lispargs)) + (setq fs-lispd (nth 3 fs-lispargs)) + (setq fs-lispe (nth 4 fs-lispargs)) + (erbeng-main + (concat erbn-char " (progn " + (substring aa + (with-temp-buffer + (insert aa) + (goto-char (point-min)) + (search-forward "lisp" nil t))) + " )") + + erbeng-proc + erbeng-nick erbeng-tgt erbeng-localp + erbeng-userinfo))) + + + (t + (erbutils-add-nick-maybe + (concat + prestring + (format + (erbutils-random + '( + ;;"%s is perhaps " + "%s is, like, " + "I heard %s is " + "I think %s is " + ;;"/me thinks %s is " + "%s -- " + ;;"%s is " + "%s is " + "hmm, %s is " + "From memory, %s is " + )) + ;; 2004-01-27 T17:21:55-0500 (Tuesday) D. Goel + ;; why regexp-quote here?? changing it.. + ;;(regexp-quote foo) + foo + ) + ;; and notice the use of result here.. + (if result + (erbutils-itemize result N shortenedp) + (erbutils-itemize result1 0)) + ))) + + + + ))) + + ;; in cond0 + ;; else + (fs-found-query-p + 'noreply) + ((not erbnocmd-describe-search-p) + ;; most likely: redirected but the redirected stuff does not exist.. + (format + "Missing redirect. %s is now on fire. (Try , dl) " + erbot-nick mainterm)) + (t + ;; prevent any further expansions on further loopbacks. + (let ((erbnocmd-describe-search-p nil)) + (fs-search + mainterm nil nil + (concat prestring "try: ") + ;;barbar + expr + )))))))) + +(defvar fs-internal-doctor-rarity 80 + "A large number(1--100) means rarer doctor inovcation upon no matches." + ) + + +(defun fsi-suggest-describe (&rest terms) + "Fallback for when `fs-describe' fails. +It then (often) calls this function, which suggests +alternatives. +Optional argument TERMS ." + (let ((term (format "%s" (first terms))) + (none (erbutils-random + '("No such term.." + "Beeeeep..." + "<LOUD ERROR MSG >.." + "No luck.." + "No match.." + "Drew a blank.." + "Does not compute.."))) + (num (random 100))) + (cond + ((< num 30) + (concat none + (format "Perhaps try: , s %s or , sw %s or , %s 0" term + term term))) + ((< num 60) + (concat none + (format "Try search or search-wide on %s" term))) + (t + (concat none + (erbutils-random '("perhaps " "why not " "please " )) + "tell me what " term " is?"))))) + + +(defun fs-do-random (&optional msg nick &rest ignored) + "Either play doctor, or zippy or flame someone.. all at random..." + (case (random 4) + (0 (fs-doctor msg)) + (1 (fs-flame nick)) + (2 (fs-yow)) + (3 (fs-fortune)) + ) + ;;(3 (fs-bottalk)) + ) + +(defcustom fs-internal-english-weights + '(58 ;; doc + 17 ;; yow + 17 ;; fortune + 4 ;; flame + 4 ;; spook + 0 ;; pray + ) + "" + :group 'erbc) + +(defun fs-do-weighted-random (&optional msg nick &rest ignored) + "Either play doctor, or zippy or flame someone.. all at random..." + (let ((foo (random 100))) + (eval + (erbutils-random + `((fs-doctor ,msg) + (fs-yow ,msg) + (fs-fortune ,msg) + (fs-flame ,nick) + (fs-spook) + (fs-pray) + ) + fs-internal-english-weights)))) + + + + +(defun fsi-yow (&rest args) + "" + (erbutils-eval-until-limited + '(yow))) + +(defun fsi-rearrange (&optional from to term &rest dummy) + "Syntax: FROM->TO in TERM. +Move the FROMth entry to the TOth position in the given TERM. +Numbering of positions starts from 0. " + (unless term (error "Syntax: , N->M in TERM (no term found)")) + (when (stringp from) + (setq from (erbn-read from))) + (when (stringp to) + (setq to (erbn-read to))) + (unless (stringp term) + (setq term (format "%s" term))) + (let* + ((exactnotes (erbbdb-get-exact-notes term)) + (realterm (erbbdb-get-exact-name term)) + (notes (and (stringp exactnotes ) (erbn-read exactnotes))) + (len (length notes)) + (max (- len 1)) + (newnotes notes) + remlist + thisnote + (tostring (downcase (format "%s" to))) + ) + (unless realterm + (error "No such term exists %S" term)) + (unless notes + (error "Report this bug. Term exists but no notes?? %S" term)) + (when (string= tostring "last") + (setq to max)) + (when (string= tostring "first") + (setq to 0)) + (unless (and (integerp from) + (<= from max) (>= from 0)) + (error "The from term %S should lie between %S and %S" + from 0 max)) + (setq thisnote (nth from notes)) + (setq remlist + (append (subseq notes 0 from) + (subseq notes (+ from 1)))) + (setq newnotes + (append (subseq remlist 0 to) + (list thisnote) + (subseq remlist to))) + (erbot-working + (fs-forget term "all") + (fs-set-term realterm newnotes)) + (erbbdb-save) + (format "Moved entry %S to %S in %S" from to realterm) + )) + +;;; 2002-09-04 T01:51:08-0400 (Wednesday) D. Goel +(defun fsi-forget (&optional name number &rest dummy) + "Remove the entry correponding to NAME in the database. +With NUMBER, forget only the NUMBERth entry of NAME. " + + ;; before we do the usual thing, let's see if we need to and can get + ;; away with exchanging name and number. + (when + (and + (numberp name) + (not (string= (format "%s" number) + "all")) + ) + (let ((fstmp number)) + (setq number name) + (setq name fstmp))) + (unless (stringp name) + (setq name (format "%s" name))) + (unless name + (error "Syntax: , forget TERM &optional NUMBER")) + (setq name (fs-correct-entry name)) + (let* + (numstring + (entries0 (erbbdb-get-exact-notes name)) + (entries (and (stringp entries0 ) + (ignore-errors (erbn-read entries0)))) + (len (length entries))) + + (unless entries + (error "No such term %s" name)) + (when (and (null number) (= len 1)) + (setq number 0)) + (setq numstring (downcase (format "%s" number))) + (when (stringp number) + (setq number (erbn-read number))) + (unless (integerp number) (setq number nil)) + (unless + (or number + (string= numstring "all")) + (error "Syntax: , forget TERM [NUMBER or \"all\"]")) + (when number + (unless (and (< number len) (>= number 0)) + (error "Number should be \"all\" or lie between 0 and %s" + (- len 1)))) + ;; Note that this does remove the field but throws a strange error.. + ;; "Record doubleplus inpresent... It is just us who are discarding + ;; this error.. ... + ;; yet the field gets deleted.. and bbdb does not get saved at this + ;; time.. because of the error ...OH well, it works.. let's move on + ;; for now.. + (cond + ( + (and (equal number 0) + (= len 1)) + (ignore-errors (erbbdb-remove name)) + (erbbdb-save) + (format "Forgot %S which had exactly one entry." name)) + ((string= numstring "all") + (ignore-errors (erbbdb-remove name)) + (erbbdb-save) + (if (= len 1) (format "Forgot the single entry in %S" name) + (format "Forgot all %s entries of %S" len name))) + (t + (fs-forget name "all") + (fs-set-term + name + (append + (subseq entries 0 number) + (subseq entries (+ number 1)))) + (message "Removed entry %s of %s" number name))))) + + + +(defvar fs-set-add-all-p nil + "") + +(make-variable-buffer-local 'fs-set-add-all-p) + + +(defun fsi-set-add-all-enable () + (setq fs-set-add-all-p t)) +(defun fsi-set-add-all-disable () + (setq fs-set-add-all-p nil)) + +(defun fsi-set-add-all-toggle () + "Enable the \"is\" command to always work. +viz. Add field even if another field is already present. This is not the +recommended usage in general, except when using automated scripts to +train the bot. The default is nil, which suggests the user to use +\"is also\" instead. " + + (setq fs-set-add-all-p (not fs-set-add-all-p)) + (format + "All-is mode set to %S. To toggle, type , (fs-set-add-all-toggle)" + fs-set-add-all-p)) + +(defun fsi-set-term (&rest args) + "Add an entry to database. +An entry gleaned from (first ARGS) is +added. (second ARGS) is the description. The entry is converted to +lowercase, and all whitespace is converted to colons." + (let ((name (fs-correct-entry (format "%s" (first args)))) + (records (cadr args))) + (unless (listp records) (setq records (list records))) + (setq records (mapcar + '(lambda (arg) (format "%s" arg)) + records)) + (let ((current + (erbbdb-get-exact-notes name))) + (cond + ((null records) + (error "Please specify a description for %s.. Type , df fs-set-term for more details" name)) + + ((and current (string= current "")) + (progn (erbbdb-create name records) + (format "Added field to the currently empty %s " name))) + (current + (if fs-set-add-all-p + (apply 'fs-set-also args) + (error + "%s is already something else.. Use 'is also'.. \n Currently: %s" name + + (let* ((notes (fs-notes name)) + (shortenedp (> (length notes) 1))) + (erbutils-itemize + (list (first notes)) + 0 shortenedp)) + + ))) + (t + (progn (erbbdb-create name records) + (format "created." + ))))))) + + +(defun fsi-chase-redirects (name) + "either return nil or the redirected entry. " + (let* ((notes (fs-notes name)) + (fir (first notes))) + (when (and (stringp fir) + ;; do not chase redirects if a term has a second + ;; entry... + ;; In that case, the first entry should not have been a + ;; redirect in any case. + (= (length notes) 1) + (equal 0 (string-match "redirect\\b" fir))) + (let* ((foo (split-string fir)) + (sec (second foo))) + (if (stringp sec) sec + name))))) + + +(defun fsi-set-also (&rest args) + "Add more fields to the the database-entry gleaned from (first ARGS). +\(second ARGS) contains the new descriptions. +Record should be a single entity here... a string..." + (let* ((name (fs-correct-entry (format "%s" (first args)))) + (record (format "%s" (second args))) + notes + ;;(notes (fs-notes name))) + ) + (setq name (or (fs-chase-redirects name) name)) + (setq notes (fs-notes name)) + (unless notes (error "But there's no such record: %s" name)) + (cond + ((member record notes) + (format "Not added. This entry already exists in the term %S" name)) + (t + (erbbdb-add name record) + ;;(run-hook-with-args 'erbot-notify-add-functions nick channel + ;;name (length notes) + (format "Added entry to the term %S" name))))) + + +(defun fsi-doctor (&rest foo) + "" + (erbutils-add-nick + (funcall 'erbot-doctor + (erbutils-stringify foo)))) + + +(defun fsi-dunnet-command (&rest foo) + ;;(let ((fs-limit-lines 8)) + ;;(fs-limit-lines + ;;(let ((dun-batch-mode t)) + (funcall 'erbot-dunnet + (erbutils-stringify foo))) + + +(defun fsi-info-search (&rest foo) + "info-search.. Coming soon...will tell the number of matches +in manuals of HURD, tramp, eshell, elisp, gnus, message, emacs, ebrowse, calc, +gdb, make sawfish, cl-emacs, bash, gnuplot, latex and others by demand...") + +;; NO! else fsbot responds to <nick> fsbot is cool! in a wrong way. +;; (defalias 'fs-is 'erbutils-info-search) + +(defun fs-hurd-info-search (&rest foo) + "Coming soon...") +(defalias 'fs-his 'erbutils-hurd-info-search) + +(defun fsi-blue-moon (&rest foo) + "Return true in a really rare case. Currently 1 in 100,000.. was 1 in +2000. " + (= (random 100000) 0)) + + +(defun fsi-set-force (&rest args) + "Forget an entry and add new fields to it.. +Syntax: , no foo is bar." + (progn + (let* ((fir (first args)) + (aa (erbbdb-get-exact-notes fir)) + (notes (and (stringp aa) (erbn-read aa))) + (len (length notes))) + (when (= len 0) + (error "There's no such term %s. Use , %s is ..." fir fir)) + (unless (= len 1) + (error + "Term has multiple entries. Examine them and ask me to forget them first")) + (erbutils-ignore-errors (funcall 'fs-forget (first args) "all")) + (apply 'fs-set-term args)))) + + +(defcustom erbn-fortune-p t + "This is true by default.. since (shell-command \"fortune\") is not +risky.. ") + + +(defun erbn-fortune (arg) + (unless arg (setq arg "")) + (cond + ((string= arg "") + (erbutils-eval-until-limited + '(erbn-shell-command-to-string (concat "fortune " arg) + (list erbn-fortune-p) + ))) + (t + (erbn-shell-command-to-string (concat "fortune " arg) + (list erbn-fortune-p) + )))) + + +(defun fsi-fortune (&rest args) + (erbn-fortune "")) + + +(defalias 'fs-f 'fs-fortune) + +(defun fs-fortunes-help (&rest args) + (concat "Type ,fortune, or any of the commands beginning with f- : " + (fs-commands "^f-"))) + +(defalias 'fs-fortune-help 'fs-fortunes-help) +(defalias 'fs-f-help 'fs-fortunes-help) + + +(defun fs-f-f (&rest args) + (erbn-fortune "-f")) + +(defun fs-f-off (&rest args) + (erbn-fortune "-o")) +(defalias 'fs-f-o 'fs-f-off) +(defalias 'fs-f-offensive 'fs-f-off) + + +(defun fs-f-debian-hints (&rest args) + (erbn-fortune "debian-hints")) +(defalias 'fs-debian-hints 'fs-f-debian-hints) + + + +(defun fs-f-twisted-quotes (&rest args) + (erbn-fortune "twisted-quotes")) +(defalias 'fs-quotes 'fs-f-twisted-quotes) +(defalias 'fs-f-quotes 'fs-f-twisted-quotes) + +(defun fs-f-literature (&rest args) + (erbn-fortune "literature")) +(defalias 'fs-f-lit 'fs-f-literature) +(defalias 'fs-lit 'fs-f-literature) +(defalias 'fs-literature 'fs-f-literature) + + + +(defun fs-f-riddles(&rest args) + (erbn-fortune "riddles")) +(defalias 'fs-riddle 'fs-f-riddles) + + + +(defun fs-f-art (&rest args) + (erbn-fortune "art")) +(defalias 'fs-art 'fs-f-art) + + + + +(defun fs-f-bofh-excuses (&rest args) + (erbn-fortune "bofh-excuses")) +(defalias 'fs-bofh 'fs-f-bofh-excuses) + + + + +(defun fs-f-ascii-art (&rest args) + (erbn-fortune "ascii-art")) +(defalias 'fs-ascii 'fs-f-ascii-art) + + + + +(defun fs-f-computers (&rest args) + (erbn-fortune "computers")) + +(defalias 'fs-f-computer 'fs-f-computers) + + + + + +(defun fs-f-cookies (&rest args) + (erbn-fortune "cookies")) + +(defalias 'fs-f-cookie 'fs-f-cookies) +(defalias 'fs-cookie 'fs-f-cookies) + + + + + +(defalias 'fs-f-cookie 'fs-f-cookies) +(defalias 'fs-cookie 'fs-f-cookies) + + +(defun fs-f-definitions (&rest args) + (erbn-fortune "definitions")) + +(defalias 'fs-def 'fs-f-defintions) + + + + +(defun fs-f-drugs (&rest args) + (erbn-fortune "drugs")) +(defalias 'fs-drugs 'fs-f-drugs) +(defalias 'fs-drug 'fs-f-drugs) + + + + +(defun fs-f-education (&rest args) + (erbn-fortune "education")) + + +(defun fs-f-ethnic (&rest args) + (erbn-fortune "ethnic")) + + + + +(defun fs-f-food (&rest args) + (erbn-fortune "food")) +(defalias 'fs-food 'fs-f-food) + + + + + + +(defun fs-f-goedel (&rest args) + (erbn-fortune "goedel")) +(defalias 'fs-goedel 'fs-f-goedel) + + + + +(defun fs-f-humorists (&rest args) + (erbn-fortune "humorists")) + + +(defun fs-f-kids (&rest args) + (erbn-fortune "kids")) + + +(defun fs-f-law (&rest args) + (erbn-fortune "law")) + +(defalias 'fs-law 'fs-f-law) + + + +(defun fs-f-linuxcookie (&rest args) + (erbn-fortune "linuxcookie")) + + +(defun fs-f-love (&rest args) + (erbn-fortune "love")) + +(defun fs-f-magic (&rest args) + (erbn-fortune "magic")) + + + +(defun fs-f-medicine(&rest args) + (erbn-fortune "medicine")) + + + +(defun fs-f-men-women (&rest args) + (erbn-fortune "men-women")) + +(defalias 'fs-sexwar 'fs-f-men-women) + + + + + +(defun fs-f-miscellaneous(&rest args) + (erbn-fortune "miscellaneous")) + +(defalias 'fs-f-misc 'fs-f-miscellaneous) + + + +(defun fs-f-news (&rest args) + (erbn-fortune "news")) + + + +(defun fs-f-people (&rest args) + (erbn-fortune "people")) + + +(defun fs-f-pets (&rest args) + (erbn-fortune "pets")) + + + +(defun fs-f-platitudes (&rest args) + (erbn-fortune "platitudes")) + + + +(defun fs-f-politics (&rest args) + (erbn-fortune "politics")) + + +(defun fs-f-science (&rest args) + (erbn-fortune "science")) + +(defun fs-f-songs-poems (&rest args) + (erbn-fortune "songs-poems")) + + +(defun fs-f-sports(&rest args) + (erbn-fortune "sports")) + + + + + +(defun fs-f-startrek (&rest args) + (erbn-fortune "startrek")) +(defalias 'fs-startrek 'fs-f-startrek) + + + + + +(defun fs-f-translate-me (&rest args) + (erbn-fortune "translate-me")) + + + +(defun fs-f-wisdom(&rest args) + (erbn-fortune "wisdom")) +(defalias 'fs-wisdom 'fs-f-wisdom) + + + +(defun fs-f-work (&rest args) + (erbn-fortune "work")) + + + +(defun fs-f-linux (&rest args) + (erbn-fortune "linux")) + +(defun fs-f-perl (&rest args) + (erbn-fortune "perl")) + +(defun fs-f-knghtbrd (&rest args) + (erbn-fortune "knghtbrd")) + + + + +(defun fs-f-quotes-emacs-channel (&rest args) + (erbn-fortune "~/fortune-emacschannelquotes")) +(defalias 'fs-f-emacs 'fs-f-quotes-emacs-channel) +(defalias 'fs-f-quotes-emacs 'fs-f-quotes-emacs-channel) +(defalias 'fs-quotes-emacs 'fs-f-quotes-emacs-channel) +(defalias 'fs-quotes-emacs-channel 'fs-f-quotes-emacs-channel) + + + + + + + + + +;; (defalias 'fs-cons 'cons) + +(defvar fs-internal-limit-line-length 125 + "Suggested value: (multiple of 80) minus 35 .. suggested: 210.") + +(defvar fs-internal-limit-length + 300 + "A multiple of fs-internal-fill-column.. we suggest: double of it.. note +that the actual limited-length will be more than this number---it may +be upto double of this number depending on how the formatting is done. +viz: we shall go to the line containing this point, and include the +entire line. +") +(defvar fs-limit-lines 8 "") + + +(defvar fs-dunnet-mode nil + "") + +(make-variable-buffer-local 'fs-dunnet-mode) + +(defvar fs-internal-fill-column 350 + "Default is to disable filling. The receipient should be able to +fill the way they like. +should be <= fs-internal-limit-length, else we might set it to be during the +code. +also, a good idea to keep it < erc's builtin flood protection length, +else your lines will get broken during middle of words by ERC. +Thus, keep it below, say 350." +) + + + + + + +(defun fsi-limit-string (&optional str maxlen &rest ignored) + "Fills the string and then then limits lines" + (fs-limit-lines (fs-fill-string str))) + + +(defun fsi-fill-string (str) + (with-temp-buffer + (insert str) + (let ((fill-column fs-internal-fill-column)) + (text-mode) + (fill-region (point-min) (point-max)) + (buffer-substring-no-properties (point-min) (point-max))))) + +(defun fsi-limit-string-old (&optional str maxlen &rest ignored) + (cond + (str + (unless (stringp str) + (setq str (format "%s" str))) + ;; get rid of all the \n first.. + (setq str + (mapconcat 'identity + (split-string str "\n") + " ")) + (when (> (length str) fs-internal-limit-length) + (setq str (concat (substring str 0 (- fs-internal-limit-length 7)) + "..<more>"))) + (with-temp-buffer + (insert str) + (goto-char (point-min)) + (let ((fill-column fs-internal-fill-column)) + (fill-paragraph nil)) + (erbutils-buffer-string))) + (t "\n"))) +(defun fsi-dunnet-mode (&optional arg) + + (setq fs-dunnet-mode + (cond + ((or (not (numberp arg)) + (= arg 0)) + (not fs-dunnet-mode)) + ((plusp arg) + t) + ((minusp arg) nil))) + + (format "Dunnet mode set to %S. To toggle, type , (dunnet-mode)" + fs-dunnet-mode)) + +(defun fsi-limit-string-no-fill (&optional str limit-lines + limit-length + limit-line-length + &rest ignored + ) + "IS OLD. i think. not used anywwhere... certainly screws up more: +is not compliant with fsbot paginator. + +Limit string to reasonable length.. +Not more than fs-internal-limit-line-length characters per line, and +not more than fs-internal-limit-length characters in all.. and not more +than fs-limit-lines in all.." + (if str + (let ((fs-limit-lines + (or limit-lines fs-limit-lines)) + (fs-internal-limit-length + (or limit-length + fs-internal-limit-length)) + (fs-limit-line-length + (or limit-line-length + fs-internal-limit-line-length))) + (fs-limit-lines + (fs-internal-limit-length + (fs-limit-line-length + str t)))) + "\n")) + + +(defvar erbn-more nil + "Alist of pending more-strings per target. Each target is a +string. ") +;;(make-variable-buffer-local 'fs-more) + +(defun erbn-more-get (&optional target) + "When target is nil, we get the latest more that occurred in ANY +channel, else we get the more from the channel indicated by target. " + (setq target (format "%S" target)) + (let ((str (cdr (assoc target erbn-more)))) + (if (and (stringp str) + (not (string= str ""))) + str + (fs-describe "more")))) + +(defalias 'fsi-more-get 'erbn-more-get) + +(defun erbn-more-set (str &optional target) + (setq target (format "%S" target)) + (if (assoc target erbn-more) + (setf (cdr (assoc target erbn-more)) str) + (add-to-list 'erbn-more (cons target str))) + (if (assoc "nil" erbn-more) + (setf (cdr (assoc "nil" erbn-more)) str) + (add-to-list 'erbn-more (cons "nil" str))) + erbn-more) + + +(defun fsi-more-set (&optional str) + (unless str (error "Need a string. ")) + (erbn-more-set str erbn-tgt)) + + + +(defun fsi-limit-lines (str0 &optional nomorep &rest ignored) + "Limits the string, both, to a reasonable number of lines and a +reasonable number of characters, trying not to break lines and not to +break words, if possible. + +Thus, that becomes quite a complicated algorithm, and we do that +here." + (let* (ans + (ender "") + (more "") + (stra (erbutils-remove-text-properties str0)) + (str (mapconcat 'identity + (remove "" (split-string stra "\n")) + "\n")) + (limitedp nil) + ptmx + this-line + this-point + new-point + ) + (with-temp-buffer + ;; fledermaus: ensure that the buffer's byteness matches the str's. + (set-buffer-multibyte (multibyte-string-p str)) + (insert str) + (setq ptmx (point-max)) + (setq this-point ptmx new-point ptmx) + (if (> fs-internal-limit-length ptmx) + (goto-char ptmx) + (setq limitedp t) + (goto-char fs-internal-limit-length)) + ;;(goto-char (point-max)) + ;;(remove-text-properties (point-min) (point-max)) + (setq this-line (count-lines (point-min) (point))) + (when (> this-line fs-limit-lines) + (setq limitedp t) + (goto-line fs-limit-lines) + (setq this-line fs-limit-lines) + ) + + (setq this-point (point) new-point this-point) + + (cond + ((and limitedp (> this-line 1)) + (progn (beginning-of-line) + (setq new-point (point)) + (backward-char) (setq this-point (point)) + )) + ((and limitedp + (progn (ignore-errors + ;; we want a backward-word 1 here, but only + ;; whitespace is regarded as word-boundary for + ;; us. + (when + (search-backward-regexp "\\( \\|\n\\|\t\\)" nil t) + (forward-char 1)) + ;;(backward-word 1) + ) + (> (point) (point-min)))) + (setq new-point (point)) + (setq this-point new-point)) + + + ;;(limitedp (setq this-point (point) new-point (point))) + + ;; in the final case, this-point and new-point are already at + ;;point-max... + (t nil)) + (setq ans (buffer-substring (point-min) this-point)) + (when + ;;(< this-point (point-max)) + limitedp + (setq more (buffer-substring new-point (point-max))) + (if + (string-match "[^ \t\n]" more ) + (setq ans (concat ans (fsi-get-more-invocation-string))) + (when nomorep (setq more ""))) + ) + ) + ;;(setq fs-more more) + (erbn-more-set more erbn-tgt) + ans)) + +(defun fsi-get-more-invocation-string () + (if (erbot-safe-nocontrol-p erbn-char) + (concat " ..[Type " erbn-char "more]") + (concat " ..[Type " erbot-nick ": more]"))) + +(defun fsi-limit-lines-old (str0 &rest ignored) + "" + (let* ( + (str (erbutils-remove-text-properties str0)) + (brstr1 (split-string str "\n")) + (brstr (remove "" brstr1)) + (ender "") + (condp (> (length brstr) fs-limit-lines)) + (goodstr + (if condp + (progn + (setq ender "..+ more") + (subseq brstr 0 (- fs-limit-lines 1))) + brstr))) + (if condp (fs-more-set + (mapconcat 'identity + (subseq brstr (- fs-limit-lines + 1)) + "\n")) + (fs-more-set "")) + (concat (mapconcat 'identity goodstr "\n") ender))) + +(defun fsi-more (&rest args) + "Display the contents of the cache. " + (let ((str (fsi-more-get erbn-tgt))) + (if (and (stringp str) + (not (string= str ""))) + str + (fs-describe "more")))) + +;; (if (and (stringp fs-more) +;; (not (string= fs-more ""))) +;; fs-more +;; (fs-describe "more"))) + + +(defun fsi-limit-lines-long (str &rest ignored) + "" + (let ((fs-limit-lines 7)) + (apply 'fs-limit-lines str ignored))) + + + +(defun fsi-limit-length (str &rest ignored) + "Don't use this, use fs-limit-lines" + (if (> (length str) fs-internal-limit-length) + (concat (substring str 0 (- fs-internal-limit-length 1)) "...<more>") + str)) + +(defun fsi-limit-line-length (&optional str &rest args) + "a subfunction.." + (let* ( + ;; this not needed now.. + (brokenstr (split-string str "\n")) + (newlsstr + (mapcar + '(lambda (givenstr) + (let ((ls nil) + (thisstr givenstr) + ) + (while (> (length thisstr) + fs-internal-limit-line-length) + (push + (concat (substring thisstr 0 fs-internal-limit-line-length + ) " <break>") + ls) + (setq thisstr (substring thisstr fs-internal-limit-line-length + (length thisstr)))) + (push thisstr ls) + (reverse ls))) + brokenstr)) + (newbrokenstr + (apply 'append newlsstr))) + (mapconcat 'identity newbrokenstr "\n"))) + + +(defvar fs-internal-directed nil) + +(defun fsi-tell-to (string nick &rest ignored) + (setq fs-nick (format "%s" nick)) + (let* ((fs-internal-directed t) + (ni (if (string= (format "%s" nick) "me") + erbot-end-user-nick + (format "%s" nick))) + (reply + (erbeng-get-reply (fs-parse (concat erbot-nick ": " + string))))) + (if (string-match ni reply) + reply + (concat ni ": " reply)))) + + +(defun fsi-apropos (&optional regexp N M &rest ignored) + (fs-apropos-basic 'erbn-apropos regexp N M)) +(defun fsi-apropos-command (&optional regexp n m &rest ignored) + (fs-apropos-basic 'erbn-apropos-command regexp n m )) +(defun fsi-apropos-variable (&optional regexp n m &rest ignored) + (fs-apropos-basic 'erbn-apropos-variable regexp n m )) +(defun fsi-apropos-function (&optional regexp n m &rest ignored) + (fs-apropos-basic 'erbn-apropos-function regexp n m )) +(defun fsi-apropos-value (&optional regexp n m &rest ignored) + (fs-apropos-basic 'apropos-value regexp n m )) +(defun fsi-apropos-documentation (&optional regexp n m &rest ignored) + (fs-apropos-basic 'erbn-apropos-documentation regexp n m )) + +(defun erbn-apropos-documentation (reg) + (mapcar 'car (apropos-documentation reg))) +(defun erbn-apropos-command (reg) + (apropos-internal reg + 'commandp)) + + + +(defun erbn-apropos-function (reg) + (apropos-internal reg + 'functionp)) + +(defun erbn-apropos-variable (reg) + (apropos-internal reg + (lambda (s) + (or (boundp s) + (user-variable-p s))))) + + +(defun erbn-apropos (regexp) + (apropos-internal regexp + (lambda (symbol) + (or + (boundp symbol) + (fboundp symbol) + (facep symbol) + (symbol-plist symbol))))) + +(defun fsi-apropos-basic (fcn &optional regexp N M &rest ignored) + "Show the apropos-matches of regexp starting at match number N" + (unless regexp + (error "Syntax: , apropos REGEXP &optional N M")) + (if (stringp N) (setq N (erbn-read N))) + (unless (integerp N) (setq N 0)) + (unless (stringp regexp) + (setq regexp (format "%s" regexp))) + (let* ((results (funcall fcn regexp)) + (len (length results)) + (str0 "") + (str1 "") + (str2 "") + (str3 "") + (str4 "")) + (unless (and (integerp M) (< M len)) + (setq M len)) + (if (and (= N 0 ) (= M len) (> len 30)) + (setq + str0 + "Perhaps Try , df fs-apropos for general syntax. ")) + (if (> len 1) (setq str1 (format "%s matches. " len))) + (if (> N 0) (setq str2 (format "Matches starting at %s->" N))) + (setq str3 (progn (format "%s" + (subseq results + N M) + ))) + (concat str0 str1 str2 str3 str4))) + + +(defun fsi-find-variable (function &rest ignore) + (fs-find-variable-internal function 'nolimit)) + +(defun fsi-find-variable-internal (function &optional nolimitp &rest ignore) + "Finds the variable named FUNCTION." + (if (stringp function) (setq function (erbn-read function))) + (cond + ((symbolp function) + (unless (boundp function) + (let ((g (intern (concat "fs-" (format "%s" function))))) + (if (boundp g) + (setq function g)))) + (let ((fstr + (save-excursion + (find-function-do-it function t 'set-buffer) + (buffer-substring (point) + (save-excursion + (forward-sexp 1) + (point)))))) + (if (equal nolimitp 'nolimit) + fstr + fstr))) + (t "\n"))) + +(defalias 'fsi-find-variable-briefly 'fs-find-variable) + + + +(defun fsi-find-function (&optional function &rest ignore) + (unless function + (error "Syntax: , find-function 'function-name")) + ;;fs-limit-lines-long + (fs-find-function-internal + function 'nolimit)) + + + + +(defalias 'fsi-find-function-briefly 'fs-find-function) + +(defun fsi-find-function-on-key (&optional k &rest rest) + (unless k + (error + "Syntax (ffo <key>)")) + (fs-find-function (fs-describe-key-briefly k))) + +(defun fsi-find-function-on-key-briefly (k &rest rest) + (fs-find-function-briefly (fs-describe-key-briefly k))) + +(defun fsi-find-function-internal (&optional function nolimitp &rest nada) + (unless function + (error + "Syntax: (ff 'fucntion)")) + (if (stringp function) (setq function (erbn-read function))) + (cond + ((symbolp function) + (unless (fboundp function) + (let ((g (intern (concat "fs-" (format "%s" function))))) + (if (fboundp g) + (setq function g)))) + (let* ((fstrbare + (save-excursion + + ;; This has the problem that it is interactive.. asks to + ;; reread file if has changed etc. + ;;(find-function function) + (find-function-do-it function nil 'set-buffer) + (buffer-substring (point) + (save-excursion + (forward-sexp 1) + (point))))) + (fstr (erbutils-function-minus-doc fstrbare))) + (if (equal nolimitp 'nolimit) + fstr + (concat (format "%s characters.." (length + fstr)) + fstr)))) + (t "\n"))) + + + +;;; 2002-11-10 T14:50:20-0500 (Sunday) D. Goel +(defun fsi-say (&rest args) + ;; let's make it safe, even though we know it will be made safe again... + (let ((response + (mapconcat + '(lambda (arg) + (format "%s" arg)) + args " "))) + (if (erbot-safe-p response) response + (concat " " response)))) + + + + + + + + + +(defun fsi-regexp-quote (str) + (unless (stringp str) + (setq str (format "%s" str))) + (regexp-quote str)) + + +(defun fsi-concat (&rest sequences) + (apply 'concat + (mapcar + 'erbutils-convert-sequence + sequences))) + + + + + +(defun fs-bunny (&rest arg) + (concat " " + (erbutils-random + '( + "Bunny is magical!" + ;;"Bunny is hot!" + "Bunny is sexy!" + "Bunny!!" + "Bunny's page: http://www.hurd-bunny.org" + "Bunny rocks" + "Bunny rules!" + "One Bunny to rule us all" + "One Bunny to rule us all ... Muhahahhaha" + "Bunny! Bunny! Bunny!" + "Bunny! Bunny! Bunny! Bunny!" + ;;"ERC in Emacs just rocks" + + )))) + + + + + + + + +(defun erbnocmd-user-fcn-definition (&optional mainterm ) + "The general syntax is (fs-describe TERM [N] [M]). +Looks for TERM, and shows its descriptions starting at description +number N, and ending at M-1. The first record is numbered 0. +" + (unless mainterm + (error + "Format , (describe TERM &optional number1 number2)")) + (unless mainterm + (setq mainterm (format "%s" mainterm))) + (setq mainterm (fs-correct-entry mainterm)) + (let* ((result0 + (erbbdb-get-exact-notes + mainterm + )) + (result1 (and (stringp result0) + (ignore-errors (erbn-read result0)))) + (len (length result1))) + (cond + ;; in cond0 + (result1 + (let* ( + ;; notice the use of result1 here, not result. + (aa (first result1)) + (bb (split-string aa)) + (cc (first bb)) + (dd (second bb)) + (ee (cdr bb)) + ) + (cond + ( + (erbutils-string= cc "redirect") + dd) + (t nil))))))) + + + +(defun fs-seen (&rest args) + (concat "seen " + (mapconcat + '(lambda (arg) (format "%s" arg)) + args + " "))) + +;; this asks the google bot for results and gives it to our channel +;;(defvar erbnocmd-google-stack nil) +;;(defun fs-google (&rest args) +;; (progn +;; (add-to-list 'erbnocmd-google-stack 'foo)) +;; (erc-cmd-MSG google "hi") +;; nil) + +(defcustom fs-internal-google-time 4 + "" :group 'erbc) + +(defcustom fs-internal-dictionary-time 4 + "" :group 'erbc) + +(defun fsi-google-raw (&rest args) + "Return a list of google results. " + (let ((concatted + (mapconcat '(lambda (a) + (format "%s" a)) + args " "))) + (with-timeout + (fs-internal-google-time + (list concatted (list "google---TimedOut"))) + (let ((results + ;; this ignore-errors is very important. + ;; since the google stuff currently gives weird errors + ;; when called from within a with-timeout loop, and a + ;; timeout actually occurs. + (ignore-errors + (mapcar 'list + (google-result-urls + (google-search concatted 0 "web")) )) )) + results)) )) + +(defvar fs-internal-google-redirect-p nil) + + +(defun fsi-googlen (n &rest args) + "Format the first n results in a nice format. " + (let* ((rawres (apply 'fs-google-raw args)) + (terms (first rawres)) + (matches (cdr rawres))) + (when (> (length matches) n) + (setq matches (subseq matches 0 n))) + (cond + ((or (not (null matches)) (not fs-internal-google-redirect-p)) + (format "[google] %s" + ;;terms + (if matches + (mapconcat 'car matches "\n") + "No match. "))) + (t + (fs-english-only + fs-internal-original-message + fs-internal-addressedatlast + 'nogoogle + ))))) + +(defun fsi-google-lucky-raw (&rest args) + (caadr (apply 'fs-google-raw args))) + + +(defun fsi-google-redirect-to-google-bot (&rest args) + (concat "google: " + (mapconcat + '(lambda (arg) (format "%s" arg)) + args " "))) + + + +(defun fsi-google-from-english (&rest args) + (let ((fs-internal-google-redirect-p t)) + (apply 'fs-google args))) + +(defun fsi-google (&rest args) + (unless args (error "Syntax: , g[oogle] [NUMBER] WORD1 &rest MORE-WORDS ")) + (let (num + (fir (first args)) + ) + (when (> (length args) 1) + (setq num + (if (numberp fir) + fir + (ignore-errors (erbn-read fir))))) + (if (numberp num) + (setq args (cdr args)) + (setq num 2)) + (apply 'fs-googlen num args))) + +(defun fsi-google-with-options (options terms &rest args) + "internal" + (apply 'fs-google (append (list options) terms args))) + +(defun fsi-google-deego (&rest args) + "Google on the gnufans.net." + (fs-google-with-options "site:gnufans.net" args)) + + +(defun fsi-google-emacswiki(&rest args) + "Google on the emacswiki site." + (fs-google-with-options "site:emacswiki.org" args)) + +(defun fsi-google-sl4 (&rest args) + "Google on the sl4 site." + (fs-google-with-options "site:sl4.org" args)) + +(defun fsi-google-planetmath (&rest args) + "Google on the planetmath site." + (fs-google-with-options "site:planetmath.org" args)) + +(defun fsi-google-octave (&rest args) + "Google on the octave site." + (fs-google-with-options "site:octave.org" args)) + + +(defalias 'fs-go 'fs-google-octave) + +(defun fs-google-wikipedia-english (&rest args) + "Google on the emacswiki site." + (fs-google-with-options "site:en.wikipedia.org" args)) + + + +(defun fs-google-wikipedia (&rest args) + "Google on the emacswiki site." + (fs-google-with-options "site:wikipedia.org" args)) + +(defun fs-google-wikipedia (&rest args) + (fs-google-with-options "site:wikipedia.org" args)) + +(defun fs-google-imdb (&rest args) + "Google on IMDB" + (fs-google-with-options "site:imdb.com" "1" args)) + +(defun fs-google-gnufans-org (&rest args) + "Google on gnufans.org" + (fs-google-with-options "site:gnufans.org" args)) + +(defun fs-google-hurdwiki(&rest args) + "Google on the emacswiki site." + (fs-google-with-options "site:hurd.gnufans.org" args)) + + +(defun fs-google-nevadamissouri (&rest args) + "Google on the emacswiki site." + (fs-google-with-options "site:nevadamissouri.net" args)) + + + +(defun fs-google-scarymath (&rest args) + "Google on scarymath" + (fs-google-with-options "site:http:scarymath.org" args)) + +(defun fs-google-twiki (&rest args) + "Google on the twiki site." + (fs-google-with-options "site:http:twiki.org" args)) + +;; unprovide nonfree sites.. +;; (defun fs-google-usemod (&rest args) +;; "Google on usemod" +;; (fs-google-with-options "site:usemod.com" args)) + +;;(defalias 'fs-google-meatball 'fs-google-usemod) + +(defun fsi-replace-regexp (&optional from to term number delimited + fixedcase literal subexp) + "TODO: implemenet fixedcase, literal, subexp... If needed, let the +author know.." + (unless (and from to term) + (error "Syntax: %s (replace-regexp FROM TO TERM &optional NUMBER" erbn-char)) + (erbnocmd-iterate-internal term number 'replace-regexp-in-string from to + nil) + (format "Replaced regexp %S with %S" from to)) + +(defun fsi-cp (name dest) + (let* ((exn (erbbdb-get-exact-notes name)) + (notes (and (stringp exn) (erbn-read exn)))) + (unless notes + (error "No such term %s" name)) + (when (erbbdb-get-exact-notes dest) + (error "%S already exists. Use merge" dest)) + (fs-set-term dest notes) + (format "Copied entries of %S to %S" name dest))) + + +(defun fsi-notes (name) + "Internal. Return the notes as a list. Else nil" + (sit-for 0) + (let ((exnotes (erbbdb-get-exact-notes name))) + (and (stringp exnotes) (erbn-read exnotes)))) + + + +(defvar erbn-merge-redirect-p t + "When true, merging also redirects.") + + + +(defun fsi-merge-generic (&optional name dest &rest args) + (unless (and name dest (not args)) + (error "Syntax: %s merge TERM1 TERM2" erbn-char)) + (setq name (format "%s" name)) + (setq dest (format "%s" dest)) + (when (string= (downcase name) (downcase dest)) + (error "Cannot merge something into itself.")) + (let ((notes (fs-notes name)) + (destnotes (fs-notes dest)) + ) + (unless notes (error "No such field %S" name)) + (unless destnotes + (error "No such field %S. Use mv" dest)) + (setq name (fs-correct-entry name)) + (setq dest (fs-correct-entry dest)) + (erbot-working + (mapcar + '(lambda (arg) + (fs-set-also dest arg)) + notes) + (fs-forget name "all")) + (when erbn-merge-redirect-p + (erbot-working + (fsi-set-term name (format "redirect %s" dest)))) + (erbbdb-save) + (if erbn-merge-redirect-p + (format "Merged %S into %S, redirected %S to %S" name dest + name dest) + (format "Merged %S into %S" name dest)))) + +(defun fsi-merge-redirect (&rest args) + (let ((erbn-merge-redirect-p t)) + (apply 'fsi-merge-generic args))) + + +(defalias 'fsi-merge 'fsi-merge-redirect) + +(defun fsi-merge-noredirect (&rest args) + (let ((erbn-merge-redirect-p nil)) + (apply 'fsi-merge-generic args))) + +(defalias 'fsi-Merge 'fsi-merge-noredirect) + + +(defun fsi-mv (&optional name dest &rest args) + "Rename NAME to DEST. +Do not confuse this function with fs-rearrange which rearranges the +order of entries within a given term. " + (when (or args (not (and name dest))) + (error "Format: %s mv foo bar" erbn-char)) + (setq name (format "%s" name)) + (setq dest (format "%s" dest)) + (cond + ((string= (downcase name) (downcase dest)) + (fs-mv-change-case name dest)) + (t + (setq name (fs-correct-entry name)) + (erbot-working (fs-cp name dest)) + (erbot-working (fs-forget name "all")) + (erbbdb-save) + (format "Renamed the term %S to %S" name dest)))) + +(defalias 'fsi-rename 'fs-mv) + +(defun fsi-mv-change-case (name dest) + (when + (let ((bbdb-case-fold-search nil)) + (erbbdb-get-exact-name dest)) + (error "Destination %S already seems to exist" dest)) + (let ((tmp (format "TMPMV-%S" (random 1000)))) + (erbot-working + (ignore-errors (fs-forget tmp)) + (fs-mv name tmp) + (fs-mv tmp dest)) + (erbbdb-save) + (format "Readjusted case from %S to %S" name dest))) + +(defun fsi-swap (name dest) + (setq name (format "%s" name)) + (setq dest (format "%s" dest)) + (unless + (let ((bbdb-case-fold-search nil)) + (erbbdb-get-exact-name dest)) + (error "Destination %S does not exist." dest)) + (unless + (let ((bbdb-case-fold-search nil)) + (erbbdb-get-exact-name name)) + (error "Source term %S does not exist." name)) + (when (string= (downcase name) (downcase dest)) + (error "Can't swap term with itself. ")) + (let ((tmp (format "TMPMV-%S" (random 1000)))) + (erbot-working + (ignore-errors (fs-forget tmp)) + (fs-mv name tmp) + (fs-mv dest name) + (fs-mv tmp dest)) + (erbbdb-save) + (format "Readjusted case from %S to %S" name dest))) + + + +(defun fsi-rearrange-from-english-internal (msg) + (catch 'erbnocmd-tag-foo + (unless (equal (length msg) 3) + (throw 'erbnocmd-tag-foo + `(fs-error (format "Syntax: %s N->M in TERM" erbn-char)))) + (unless (equal (downcase (format "%s" (second msg))) "in") + (throw 'erbnocmd-tag-foo + `(fs-error (format "Syntax: %s N->M in TERM" erbn-char)))) + (let (term + fromto + lenfromto + ) + (setq term (third msg)) + (setq fromto + (split-string (first msg) "->")) + (setq lenfromto (length fromto)) + (unless (= lenfromto 2) + (throw 'erbnocmd-tag-foo + `(fs-error (format "Syntax: %s N->M in TERM" erbn-char)))) + `(fs-rearrange ,(first fromto) ,(second fromto) ,term)))) + + + + +(defun fsi-replace-string-from-english-internal (msg) + "Parse the input english message to return an elisp equivalent. +MSG here is a list which needs to be combined. " + (let* + ( + ;; original length + (leno (length msg)) + ;; remaining msg + (remmsg msg) + (remlen leno) + las + number + remengmsg + remenglen + revengmsg + splitloc + from + to + term + (ans nil) + (termcheckp nil) + fcn + sr + ) + (catch 'erbnocmd-repl-error + + (unless (and (>= leno 3) + (equal 0 (string-match "\\(s\\|r\\)/" (first remmsg)))) + (throw 'erbnocmd-repl-error + `(fs-error + "Format: s/foo.../bar..../ in TERM &optional N"))) + (setq sr + (if (equal 0 (string-match "s" (first remmsg))) "s" "r")) + (setq las (first (last remmsg))) + (setq number (and (stringp las) (erbn-read las))) + (if (or (numberp number) + (equal 0 (string-match + "all" + (downcase (format "%s" number))))) + (setq remmsg (subseq remmsg 0 (- remlen 1))) + (progn + (setq termcheckp t number nil))) + + ;; next comes the term + (setq remlen (length remmsg)) + (setq term (first (last remmsg))) + (setq remmsg (subseq remmsg 0 (- remlen 1))) + + (when termcheckp + (let* ((exn (erbbdb-get-exact-notes term)) + (notes (and (stringp exn) (erbn-read exn))) + (len (length notes))) + (if (> len 1) + (throw 'erbnocmd-repl-error + `(fs-error "Which numbered entry? %s/foo/bar in TERM NUMBER" , sr +)) + (setq number 0)))) + + ;; now the "in" + (setq remlen (length remmsg)) + (setq las (first (last remmsg))) + (unless + (string= "in" (downcase (format "%s" las))) + (throw 'erbnocmd-repl-error + `(fs-error + "Format: %s/foo.../bar..../ in TERM &optional NUMBER" + ,sr )) + ) + + (setq remmsg (subseq remmsg 0 (- remlen 1))) + (setq remlen (length remmsg)) + (setq remengmsg (mapconcat 'identity remmsg " ")) + + ;; remove trailing whitespace + ;; no need to check for length since we know msg stars with s/ + (while + (member + (aref remengmsg (- (length remengmsg) 1)) + '(9 ;; tab + 32 ;; space + 10 ;; newline + )) + (setq remengmsg (subseq remengmsg 0 (- (length remengmsg) 1)))) + ;; remove one trailing / + ;; no need to check for length since we know msg stars with s/ + (setq remenglen (length remengmsg)) + (when (equal + (aref + remengmsg (- (length remengmsg) 1)) + 47) + (setq remengmsg (subseq remengmsg 0 (- (length remengmsg) 1)))) + + (setq remenglen (length remengmsg)) + (unless (> (length remengmsg) 2) + (throw 'erbnocmd-repl-error + `(fs-error + "Format: %s/foo.../bar..../ in TERM &optional N" + ,sr + )) + + ) + ;; this should take care of almost anything imaginable. + ;; one can still construct "missing" cases but one should just use + ;; lisp for that. + ;; remove the s/ + (if (equal 0 (string-match "s" remengmsg)) + (setq fcn 'fs-replace-string) + (setq fcn 'fs-replace-regexp)) + (setq remengmsg (subseq remengmsg 2)) + ;; now find the last single / + (with-temp-buffer + (insert remengmsg) + (goto-char (point-max)) + (setq splitloc + (search-backward-regexp "[^/]/\\([^/]\\|$\\)" nil t))) + (unless splitloc + (throw 'erbnocmd-repl-error + `(fs-error + "Format: %s/foo.../bar..../ in TERM &optional N" + ,sr + ))) + (setq from (substring remengmsg 0 splitloc)) + (setq to (substring remengmsg (+ splitloc 1))) + (when (string= from "") + (throw 'erbnocmd-repl-error + `(fs-error "Replacement string must have nonzero size.."))) + ;; singlify the double /'s. + (setq from + (replace-regexp-in-string "//" "/" from)) + (setq to + (replace-regexp-in-string "//" "/" to)) + `(,fcn ,from ,to ,term ,(format "%s" number))))) + + + +(defun fsi-replace-string (&optional from to term number) + (unless (and from to term) + (error + "Syntax: %s s/foo.../bar in TERM [NUMBER or ALL]" erbn-char)) + (erbot-working + (erbnocmd-iterate-internal + (or (erbbdb-get-exact-name term ) term) + number 'erbutils-replace-string-in-string + from to nil)) + (erbbdb-save) + (format "Replaced string %S with %S." from to)) + +(defun erbnocmd-iterate-internal (term number function + &rest arglist) + + " Perform FUNCTION on the NUMBERth entry of TERM. +If NUMBER is not nil, the replacement is done for each entry in +the TERM. The function uses the term as its third argument. +Meant for use by fs-replace-regexp etc. + +The last entry of ARGLIST is assumed to be itself a list of arguments, +let's call it lastlist. Let the other entries of arglist be called +initargs. Then the function is applied as (function @initargs string +@arglist). Where the string is the string gotten from the TERM. " + + (setq number (format "%s" number)) + (let* + ((exactnotes (erbbdb-get-exact-notes term)) + (notes (and (stringp exactnotes) (erbn-read exactnotes))) + (len (length notes)) + newnotes + newnote + (lenargs (length arglist)) + (initargs (subseq arglist 0 (- lenargs 1))) + (finargs (first (last arglist))) + (numnum (erbn-read number)) + ) + (when (and (null number) (= len 1)) (setq number 0)) + (unless exactnotes (error "No such term: %S" term)) + (cond + ((string= "all" (downcase number)) + (setq newnotes + (mapcar + (lambda (thisentry) + (apply function (append initargs (list thisentry) + finargs))) + notes))) + ((or (not (numberp numnum)) + (< numnum 0) + (>= numnum len)) + (error "Number should be \"all\" or within %s and %s, given was: %s" + 0 (- len 1) numnum)) + (t + (setq newnotes + (append + (subseq notes 0 numnum) + (list + (apply function (append initargs + (list (nth numnum notes)) + finargs))) + (subseq notes (+ numnum 1) len))))) + (fs-forget term "all") + (fs-set-term term newnotes))) + + + +(defun fsi-info-emacs (&optional regexp) + (fs-info-file "emacs" regexp)) + +(defun fsi-info-elisp (&optional regexp) + (fs-info-file "elisp" regexp)) + +(defun fsi-info-efaq (&optional regexp) + (fs-info-file "efaq" regexp)) + +(defun fsi-info-eintr (&optional regexp) + (fs-info-file "eintr" regexp)) + +(defun fsi-info (&optional regexp) + (or + (ignore-errors (fs-info-emacs regexp)) + (ignore-errors (fs-info-elisp regexp)) + (ignore-errors (fs-info-efaq regexp)) + (ignore-errors (fs-info-eintr regexp)) + (error "Not found in Emacs manual, elisp manual, Emacs FAQ and Elisp intro"))) + + + + + +(defun fsi-info-file (&optional infofile regexp) + (unless regexp + (error "Syntax: %s info-node nodename REGEXP" erbn-char)) + (unless (stringp regexp) (setq regexp (format "%s" regexp))) + + + (unless infofile (error "Syntax: %s info info-file REGEXP" + erbn-char)) + (unless (stringp infofile) (setq infofile (format "%s" infofile))) + + (cond + ((ignore-errors (Info-goto-node + (concat "(" infofile ")" regexp))) + (concat "Press C-x C-e after: (info \"(" + infofile ")" Info-current-node + "\")") + ) + ((progn + (ignore-errors + (Info-goto-node (concat "(" infofile ")")) + (Info-top-node) + (Info-search regexp))) + (concat "Press C-x C-e after: (info \"(" + infofile + ")" Info-current-node + "\")")) + (t (error "Regexp or infofile not found in the file")))) + + +(defun fsi-locate-library (&optional arg &rest rest) + "REST WILL be ignored :-)" + (unless arg (error "Syntax: %s locate-library LIB" erbn-char)) + (unless (stringp arg) + (setq arg (format "%s" arg))) + (locate-library arg)) + + +(defun fsi-avg (&rest numbers) + (cond + ((null numbers) 'NaN) + (t (fs-// (apply '+ numbers) + (length numbers))))) + + +(defun fsi-dict (&optional word &rest ignore) + (unless word (error "Syntax: %s d[ict] word" erbn-char)) + (unless (stringp word) (setq word (format "%s" word))) + (fs-dictionary-search word)) + +(defalias 'fsi-dictionary 'fs-dict) + +(defun fsi-dictionary-search (word) + "lispy.. not for interface. " + (ignore-errors (kill-buffer "*Dictionary buffer*")) + (unless (stringp word) + (setq word (format "%s" word))) + (with-timeout + (fs-internal-dictionary-time "Dictionary--TimedOut") + (dictionary-search word) + (save-window-excursion + (switch-to-buffer "*Dictionary buffer*") + (goto-line 3) + (buffer-substring-no-properties (point) (point-max))))) + + + + + +;;8/10/00 +;;;###autoload +(defun fsi-// (&rest args) + "My sensible definition of /. +Does not say 4 / 3 = 0. Note: this usues equal and not equalp, the +last time i checked , equalp seemed to work as well.. " + (let ((aa (apply '/ args))) + (if (equal (car args) (apply '* aa (cdr args))) + aa + (apply '/ (cons (float (car args)) (cdr args)))))) + + +(defun fsi-channel-members-all () + (cond + ;; for earlier ERC. + ((boundp 'channel-members) channel-members) + ;; for later CVS versions of ERC. + (t nil))) + +(defun fsi-channel-members (&optional n m &rest args) + (when (stringp n) + (setq n (ignore-errors (erbn-read n)))) + (when (stringp m) + (setq m (ignore-errors (erbn-read m)))) + (unless (integerp n) (setq n 0)) + (unless (integerp m) (setq m nil)) + (subseq (fs-channel-members-all) n m)) + + +(defun fsi-length-channel-members (&rest args) + (cond + ;; for new erc versions + ((boundp erc-channel-users) + (hash-table-count erc-channel-users)) + (t (length (fs-channel-members-all))))) + + +(defalias 'fsi-number-channel-members 'fs-length-channel-members) + +(defun fsi-cto (&rest args) + (let* ((page (mapconcat (lambda (arg) (format "%s" arg)) + args "%20")) + (pg1 "http://cliki.tunes.org/") + ;;(pg2 "http://206.63.100.249/") + (pg3 + (erbutils-replace-strings-in-string + '("+" " " "\t") '("%2B" "%20" "%20") page))) + (format "%s%s" + pg1 pg3))) + + +;;; (defun fs-karma (&rest args) +;;; (let ((fir (first args))) +;;; (unless +;;; (and +;;; args +;;; fir) +;;; (error (format "Syntax: , karma ENTITY"))) +;;; (setq fir (downcase (format "%s" fir))) +;;; (let ((result (erbkarma fir))) +;;; (if result +;;; (format "%s's karma is %s" fir result) +;;; (format +;;; "No karma defined for %s, use ,ENTITY++ or ,karma-create" fir +;;; ))))) + +;;; (defvar erbn-karma-pt 10) + +;;; (defun fs-karma-increase (&optional arg points &rest ignore) +;;; (unless arg (error "Syntax: foo++ [&optional NUMBER]")) +;;; (when (stringp points) +;;; (setq points (ignore-errors (read points)))) +;;; (unless (and (integerp points) +;;; (<= (abs points) erbn-karma-pt)) +;;; (setq points erbn-karma-pt)) +;;; (setq arg (downcase (format "%s" arg))) +;;; (erbkarma-increase arg points)) + +(defun fsi-karma-increase (&rest args) + (if (car args) + (progn + + (ignore-errors (incf (gethash (intern (format "%s" (car args))) erbn-money) 1000)) + + + (format + "Noted, %s. One %s-point for %s!" + nick + (erbutils-random '("brownie" "karma" "wiki" "rms" "lispy")) + (car args)) + + + ) + ;;(error "Karma system is currently being reworked. ") + "")) + + + + +(defalias 'fs-karma-decrease 'fs-karma-increase) + +;;; (defun fs-karma-decrease (&optional arg points &rest ignore) +;;; (unless arg (error "Syntax: foo++ [&optional NUMBER]")) +;;; (when (stringp points) +;;; (setq points (ignore-errors (read points)))) +;;; (unless (and (integerp points) +;;; (<= (abs points) erbn-karma-pt)) +;;; (setq points erbn-karma-pt)) +;;; (setq arg (downcase (format "%s" arg))) +;;; (erbkarma-decrease arg points)) + + + +;;; (defun fs-karma (&optional foo) +;;; (if foo (setq foo (downcase (format "%s" foo)))) +;;; (erbkarma foo)) + +;;; (defalias 'fs-karma-best 'erbkarma-best) + + +(defalias 'fsi-ncm 'fs-length-channel-members) +(defun fs-superiorp (&rest args) + (erbutils-random '(t nil))) +(defun fs-sucksp (&rest args) + (erbutils-random '(t nil))) +(defun fs-bugp (&rest args) + (erbutils-random '(t nil))) + + +(defun fsi-country (&optional ct) + (unless ct (error "Syntax: %s country NM (example , country jp" erbn-char)) + (setq ct (format "%s" ct)) + (let ((addp (and (> (length ct) 1) + ;; does not start with . + (not (= (aref ct 0) 46))))) + (if addp (setq ct (concat "." ct)))) + (erbcountry (downcase ct))) + + + +(defun fsi-country-search (&rest names) + (unless names (error + "Syntax: %s country-search NM (example , country japa" erbn-char)) + (erbcountry-search + (mapconcat (lambda (arg) (format "%s" arg)) names " "))) + + +;;; 2003-02-09 T13:40:04-0500 (Sunday) D. Goel +(defun fsi-spook (&rest args) + (with-temp-buffer + (spook) + (goto-char (point-min)) + (forward-line 1) + (buffer-substring-no-properties + (progn (beginning-of-line 1) (point)) + (progn (end-of-line 1) (point))))) + + +(defun fs-explode (&rest args) + (let ((pieces + (erbutils-random '("a thousand" "a million" "a gazillion" + "aleph_2"))) + (watch + (erbutils-random '("" "you watch as " + "you run for cover as " + )))) + (eval + (erbutils-random + '((format "%s%s explodes into %s pieces!" + watch erbot-nick pieces) + (format "%s, with botheart broken into %s pieces, has left: \"Goodbye\"" + erbot-nick pieces)))))) + + + + +(defalias 'fs-die 'fs-explode) +(defalias 'fs-die! 'fs-explode) +(defalias 'fs-Die! 'fs-explode) +(defalias 'fs-Die 'fs-explode) +(defalias 'fs-DIE 'fs-explode) +(defalias 'fs-leave 'fs-explode) +(defalias 'fs-exit 'fs-explode) +(defalias 'fs-quit 'fs-explode) +(defalias 'fs-shut 'fs-explode) +(defalias 'fs-stfu 'fs-explode) +(defalias 'fs-STFU 'fs-explode) + + + +(defun fsi-morse (&rest str) + (apply 'erbutils-region-to-string 'morse-region str)) +(defun fsi-unmorse (&rest str) + (apply 'erbutils-region-to-string 'unmorse-region str)) + +(defun fsi-rot13 (&rest str) + (let (st) + (cond + ((= (length str) 1) + (setq st (format "%s" (first str)))) + (t (setq st (mapconcat + (lambda (a) (format "%s" a)) str " ")))) + (erbutils-rot13 st))) + +(defun fsi-studlify (&rest s) + (apply 'erbutils-region-to-string + (lambda (&rest args) + (ignore-errors (apply + 'studlify-region args))) + s)) + + +(defun fsi-h4x0r (&rest s) + (require 'h4x0r) + (funcall + 'h4x0r-string + (mapconcat + (lambda (a) (format "%s" a)) + s " "))) + + +(defalias 'fs-h4 'fs-h4x0r) +(defalias 'fs-h4 'fs-h4xor) +(defalias 'fs-h4 'fs-haxor) +(defalias 'fs-h4 'fs-hax0r) + +(defalias 'fs-l33t 'fs-h4x0r) +(defalias 'fs-leet 'fs-h4x0r) + +(defalias 'fs-stud 'fs-studlify) + +(defcustom fs-internal-studlify-maybe-weights + '(100 1) + "" + :group 'erbc) + +(defun fsi-studlify-maybe (&rest args) + (eval + (erbutils-random + '((erbutils-stringify args) + (apply 'fs-studlify args)) + fs-internal-studlify-maybe-weights + ))) + + +(defcustom fs-internal-h4x0r-maybe-weights + '(100 1) + "" + :group 'erbc) + +(defun fsi-h4x0r-maybe (&rest args) + (let* + ((aa (erbutils-stringify args)) + (bb + (ignore-errors + (eval + (erbutils-random + '(aa + (apply 'fs-h4x0r args)) + fs-internal-h4x0r-maybe-weights + ))))) + (or bb aa))) + + +(defalias 'fs-stud-maybe 'fs-studlify-maybe) + + +(defalias 'fs-studlify-word 'studlify-word) + + +(defun fsi-princ (a &rest ignore) + (princ a)) + + +(defun fsi-pray (&rest args) + (require 'faith) + (faith-quote)) + +(defalias 'fs-all-hail-emacs 'fs-pray) +(defalias 'fs-hail-emacs 'fs-pray) +(defalias 'fs-faith 'fs-pray) + +(erbutils-defalias-i '(faith-correct-string)) +(erbutils-defalias-i '(member)) + +(erbutils-defalias-i '(stringp consp symbolp numberp listp arrayp + boundp bufferp commandp consp endp + equalp evenp oddp facep fboundp + featurep functionp integerp keywordp + keymapp listp markerp minusp natnump + nlistp numberp overlayp plusp rationalp + sequencep subrp tailp timerp + typep vectorp windowp xemacsp zerop)) + + +(erbutils-defalias-i + '(char-to-string string-to-char string-to-int + string-to-number string-to-list + string-to-number-with-radix number-to-string + pp-to-string int-to-string number-to-string + prin1-to-string rational-to-string rational-to-float + radians-to-degrees rx-to-string degrees-to-radians)) + + + + + +(defun erbn-shell-test (string &optional substrings) + "Return t if any of the substrings matches string.. Used to weed +out harmful shell code.. + +See: http://www.w3.org/Security/faq/wwwsf4.html#CGI-Q7 + + +" + (unless substrings + (setq substrings (list " " "<" ">" "-" "`" "$" "=" ";" "&" "'" + "\\" "\"" "|" "*" "?" "~" "^" "(" ")" "[" + "]" "{" "}" "\n" "\r" ))) + (let ((found nil)) + (mapcar (lambda (arg) + (when (string-match (regexp-quote arg) string) + (setq found t))) + substrings) + found)) + +(defalias 'fsi-shell-test 'erbn-shell-test) + +(defcustom erbn-internal-web-page-time 10 + "" :group 'erbc) +(defcustom erbn-url-functions-p nil + "when true, enable url functions, provided that erbot-paranoid-p +allows us that. + +The reason you may not want to enable this function is that when you +fetch url's like http://205.188.215.230:8012 (icecast, etc. content), +url.el continues fetching that url forever (discovered by indio). The +bot times out, but url continues fetching it in the background, +slowing down your bot." + :group 'erbc) + + + +(defmacro erbn-with-web-page-buffer (site &rest body) + (let ((buffer (make-symbol "web-buffer"))) + `(progn + (unless (and (not erbot-paranoid-p) + erbn-url-functions-p) + (error "erbn-url-functions-p is disabled")) + (with-timeout (erbn-internal-web-page-time "HTTP time out") + (let ((,buffer (url-retrieve-synchronously ,site))) + (when (null ,buffer) + (error "Invalid URL %s" site)) + (save-excursion + (set-buffer ,buffer) + (goto-char (point-min)) + (prog1 + (progn + ,@body) + (kill-buffer ,buffer)))))))) + +(defun fsi-web-page-title (&optional site &rest args) + (unless site (error "Syntax: %s web-page-title SITE" erbn-char)) + (setq site (format "%s" site)) + (erbn-with-web-page-buffer site + (let* ((case-fold-search t) + (beg (search-forward "<title>" nil t)) + (end (search-forward "</title>" nil t))) + (concat "That page title is " + (if (and beg end) + (erbutils-cleanup-whitespace + (buffer-substring beg (- end 8))) + "not available"))))) + +(defun fsi-wserver (&optional site &rest args) + (unless site (error "Syntax: %s wserver SITE" erbn-char)) + (setq site (format "%s" site)) + (erbn-with-web-page-buffer site + (buffer-substring (point-min) + (or (search-forward "\n\n" nil t) + (point-max))))) + +(defalias 'fs-webserver 'fs-wserver) + +(defun fsi-web (&optional site &rest args) + (unless site (error "Syntax: %s web SITE" erbn-char)) + (setq site (format "%s" site)) + (erbn-with-web-page-buffer site + (shell-command-on-region (or (search-forward "\n\n" nil t) + (point-min)) + (point-max) + "w3m -dump -T text/html" t t) + (buffer-substring (point) (mark)))) + + +;;;###autoload +(defun fsi-length-load-history () + (interactive) + (message "%s%s%S" + (length load-history) + " ..." (mapcar 'car load-history))) + + +;(defun fsi-load-history () +; load-history) +;(defun fsi-load-history () +; load-history) + +(defalias 'fs-google: 'fs-google) + + + +(defconst fs-bunny 142857) +(defconst fs-pi pi) +(defconst fs-e e) +(defconst fs-euler e) +(defconst fs-emacs-version emacs-version) + +(defalias 'fsi-emacs-version 'emacs-version) +(defalias 'fsi-gnus-version 'gnus-version) + +;; the short aliases.. +(defalias 'fsi-a 'fs-apropos) +(defalias 'fs-da 'fs-apropos) +(defalias 'fsi-ac 'fs-apropos-command) +(defalias 'fsi-ad 'fs-apropos-documentation) +(defalias 'fsi-af 'fs-apropos-function) +(defalias 'fsi-av 'fs-apropos-variable) + +(defalias 'fsi-c 'fs-commands) +(defalias 'fsi-d 'fs-dict) +(defalias 'fsi-dict: 'fs-dict) + +(defalias 'fsi-dl 'fs-describe-literally) +(defalias 'fsi-doc 'fs-doctor ) +(defalias 'fsi-dkb 'fs-describe-key-briefly ) + +(defalias 'fsi-dk 'fs-describe-key) +(defalias 'fsi-dkf 'fs-describe-key-and-function) +(defalias 'fsi-dkl 'fs-describe-key-long) + +(defalias 'fs-lkgg 'fs-lookup-key-gnus-group) +(defalias 'fs-dkgg 'fs-lookup-key-gnus-group) + +(defalias 'fs-dkgs 'fs-lookup-key-gnus-summary) +(defalias 'fs-lkgs 'fs-lookup-key-gnus-summary) + +(defalias 'fs-lkm 'fs-lookup-key-message) +(defalias 'fs-lkm 'fs-lookup-key-message) + + +(defalias 'fsi-df 'fs-describe-function ) +(defalias 'fsi-cond 'cond) +(defalias 'fsi-if 'if) +(defalias 'fsi-when 'when) +(defalias 'fsi-dfl 'fs-describe-function-long ) +(defalias 'fsi-dv 'fs-describe-variable ) +(defalias 'fsi-ff 'fs-find-function) +(defalias 'fsi-ffb 'fs-find-function-briefly) +(defalias 'fsi-ffo 'fs-find-function-on-key) +(defalias 'fsi-ffob 'fs-find-function-on-key-briefly) +(defalias 'fsi-fv 'fs-find-variable) +(defalias 'fsi-fvb 'fs-find-variable-briefly) +(defalias 'fsi-? 'fs-help) +(defalias 'fs-32 'fs-help) +(defalias 'fsi-s 'fs-search) +(defalias 'fsi-sw 'fs-search-wide) +(defalias 'fsi-sws 'fs-search-wide-sensitive) +(defalias 'fsi-wi 'fs-where-is) +(defalias 'fs-wigg 'fs-where-is-gnus-group) +(defalias 'fs-wigs 'fs-where-is-gnus-summary) +(defalias 'fs-wim 'fs-where-is-message) +(defalias 'fs-dw 'fs-where-is) +;;(defalias 'fs-yo 'fs-hi) + +;; basic functions +(defalias 'fsi-lambda 'lambda) +(defalias 'fsi-length 'length) +(defalias 'fsi-sqrt 'sqrt) + +(defalias 'fsi-= '=) +(defalias 'fsi-/= '/=) +(defalias 'fsi-< '<) +(defalias 'fsi-> '>) +(defalias 'fsi-<= '<=) +(defalias 'fsi->= '>=) +(defalias 'fsi-not 'not) +(defalias 'fsi-and 'and) +(defalias 'fsi-or 'or) +(defalias 'fs-lart 'fs-flame) + +(defalias 'fsi-null 'null) +(defalias 'fsi-atom 'atom) +;;(defalias 'fsi-stringp 'stringp) +;;(defalias 'fsi-consp 'consp) + + + + +(defalias 'fsi-equal 'equal) +(defalias 'fsi-equalp 'equalp) +(defalias 'fsi-eql 'eql) +;; rr is used for russian-roulette now.. +;;(defalias 'fs-rr 'fs-replace-regexp) +(defalias 'fs-rs 'fs-replace-string) +(defalias 'fsi-+ '+) +(defalias 'fsi-- '-) +(defalias 'fsi-* '*) +(defalias 'fsi-/ '/) +(defalias 'fsi-less 'fs-more) +(defalias 'fsi-list 'list) +(defalias 'fsi-car 'car) +(defalias 'fs-ct 'erbccountry) +(defalias 'fsi-cdr 'cdr) +(defalias 'fsi-cons 'cons) +(defalias 'fsi-append 'append) +(defalias 'fsi-first 'first) +(defalias 'fsi-second 'second) +(defalias 'fsi-third 'third) +(defalias 'fsi-fourth 'fourth) +(defalias 'fsi-fifth 'fifth) +(defalias 'fsi-sixth 'sixth) +(defalias 'fsi-seventh 'seventh) +(defalias 'fsi-eighth 'eighth) +(defalias 'fsi-ninth 'ninth) +(defalias 'fsi-tenth 'tenth) +(defalias 'fsi-subseq 'subseq) +(defalias 'fsi-ceiling 'ceiling) +(defalias 'fsi-ceiling* 'ceiling*) +(defalias 'fsi-concatenate 'concatenate) +(defalias 'fsi-cos 'cos) +(defalias 'fsi-count-lines 'count-lines) + +(defalias 'fsi-last 'last) +(defalias 'fsi-llh 'fs-length-load-history) +(defalias 'fsi-error 'erbutils-error) +(defalias 'fsi-expt 'expt) +(defalias 'fsi-exp 'exp) +(defalias 'fsi-exchange-point-and-mark 'exchange-point-and-mark) +(defalias 'fs-rq 'fs-regexp-quote) +;; (defalias 'fs-function 'identity) + +(defalias 'fsi-identity 'identity) +(defalias 'fsi-nth 'nth) +(defalias 'fsi-nthcdr 'nthcdr) +(defalias 'fsi-random 'random) +(defalias 'fsi-random-choose 'erbutils-random) +(defalias 'fsi-remove 'remove) +(defalias 'fsi-replace-regexp-in-string 'replace-regexp-in-string) +(defalias 'fsi-replace-match 'replace-match) + +(defalias 'fsi-number-to-string 'number-to-string) +(defalias 'fsi-format 'format) +(erbutils-defalias-i '(format-time-string)) + +(defalias 'fsi-split-string 'split-string) +(defalias 'fsi-rm 'fs-forget) +(defalias 'fsi-progn 'progn) +(defalias 'fsi-ignore-errors 'ignore-errors) +(defalias 'fsi-lcm 'lcm) +(defalias 'fsi-let 'let) +(defalias 'fsi-let* 'let*) +(defalias 'fsi-ll 'fs-locate-library) +(defalias 'fsi-g 'fs-google) +(defalias 'fsi-gcd 'gcd) +(defalias 'fs-gd 'fs-google-deego) + +(defalias 'fsi-ge 'fs-google-emacswiki) +(defalias 'fs-gs 'fs-google-sl4) + +(defalias 'fs-gw 'fs-google-wikipedia) +(defalias 'fs-gi 'fs-google-imdb) +(defalias 'fs-gwe 'fs-google-wikipedia-english) +(defalias 'fs-gh 'fs-google-hurdwiki) +;;(defalias 'fs-gm 'fs-google-meatball) +(defalias 'fs-gnufans 'fs-google-gnufans-net) +(defalias 'fs-gg 'fs-google-gnufans-net) +(defalias 'fs-ggn 'fs-google-gnufans-net) +(defalias 'fs-ggo 'fs-google-gnufans-org) +(defalias 'fs-gn 'fs-google-nevadamissouri) +(defalias 'fs-gp 'fs-google-planetmath) +(defalias 'fs-gt 'fs-google-twiki) +;;(defalias 'fs-gu 'fs-google-usemod) + +(defalias 'fsi-mark 'mark) +(defalias 'fsi-point 'point) +(defalias 'fsi-pop-mark 'pop-mark) +(defalias 'fsi-push-mark 'push-mark) +(defalias 'fsi-floor 'floor) +(defalias 'fsi-floor* 'floor*) + +(defalias 'fsi-round 'round) +(defalias 'fsi-round* 'round*) + +(defalias 'fsi-setcar 'setcar) +(defalias 'fsi-setcdr 'setcdr) +(defalias 'fsi-sin 'sin) +(erbutils-defalias-i '(sleep-for sit-for)) +(defalias 'fsi-string 'string) + +(defalias 'fsi-string-as-multibyte 'string-as-multibyte) +(defalias 'fsi-string-bytes 'string-bytes) +(defalias 'fsi-string-equal 'string-equal) +(defalias 'fsi-string-key-binding 'string-key-binding) +(defalias 'fsi-string-lessp 'string-lessp) +(defalias 'fsi-string-make-multibyte 'string-make-multibyte) +(defalias 'fsi-string-make-unibyte 'string-make-unibyte) +(defalias 'fsi-string-to-char 'string-to-char) +(defalias 'fsi-string-to-int 'string-to-int) +(defalias 'fsi-string-to-list 'string-to-list) +(defalias 'fsi-string-to-number 'string-to-number) +(defalias 'fsi-string-to-sequence 'string-to-sequence) +(defalias 'fsi-string-to-syntax 'string-to-syntax) +(defalias 'fsi-string-to-vector 'string-to-vector) +(defalias 'fsi-string-width 'string-width) +(defalias 'fsi-symbol-file 'symbol-file) + +(defalias 'fsi-tan 'tan) +(defalias 'fsi-cos 'cos) +(defalias 'fsi-sin 'sin) +(defalias 'fsi-atan 'atan) +(defalias 'fsi-asin 'asin) +(defalias 'fsi-acos 'acos) +(defalias 'fsi-tanh 'tanh) + +(erbutils-defalias-i + '(timezone-world-timezones + timezone-months-assoc + timezone-make-date-arpa-standard timezone-make-date-sortable + timezone-make-arpa-date timezone-make-sortable-date + timezone-make-time-string timezone-parse-date timezone-parse-time + timezone-zone-to-minute timezone-time-from-absolute + timezone-time-zone-from-absolute timezone-fix-time + timezone-last-day-of-month timezone-leap-year-p timezone-day-number + timezone-absolute-from-gregorian)) + + +(defalias 'fsi-truncate 'truncate) + +(defalias 'fsi-truncate* 'truncate*) +(defalias 'fsi-truncate-string 'truncate-string) +(defalias 'fsi-truncate-string-to-width 'truncate-string-to-width) + + +(defalias 'fsi-erc-version 'erc-version) +(defalias 'fsi-sv 'erc-cmd-SV) +(defalias 'fsi-erc-cmd-SV 'erc-cmd-SV) +(defalias 'fsi-smv 'erc-cmd-SMV) +(defalias 'fsi-erc-cmd-SMV 'erc-cmd-SMV) +(defalias 'fsi-sm 'erc-cmd-SM) +(defalias 'fsi-cmd-SM 'erc-cmd-SM) +(defalias 'fsi-stringify 'erbutils-stringify) +;; (defalias 'fs-while 'while) + +;;;==================================================== + +;;;==================================================== +;; ERRORS: + +(defun fsi-load-library (&rest args) + (error "Use 'require instead. ")) + +(defalias 'fs-load 'fs-load-library) +(defalias 'fs-load-file 'fs-load-library) + + + +;; cl-extra.el + +(defalias 'fsi-equalp 'equalp) +;; done gcd +;; done lcm +(defalias 'fsi-isqrt 'isqrt) +(defalias 'fsi-floor* + 'floor* ) + +(defalias 'fsi-ceiling* +'ceiling* ) + +(defalias 'fsi-truncate* +'truncate*) + +;; done round* + +(defalias 'fsi-mod* + 'mod* ) + +(when (ignore-errors + (require 'geek)) + (erbutils-defalias-i '(geek-code))) + +(defalias 'fsi-rem* + 'rem* ) + +(erbutils-defalias-i + '(signum + random* + ;; yes? + make-random-state + random-state-p + + most-positive-float most-negative-float + least-positive-float least-negative-float + least-positive-normalized-float least-negative-normalized-float + float-epsilon float-negative-epsilon cl-float-limits ;; done subseq + concatenate revappend nreconc list-length tailp cl-copy-tree + copy-tree + ;;get* getf + ;;cl-set-getf cl-do-remf cl-remprop remprop + cl-make-hash-table + cl-hash-table-p cl-not-hash-table cl-hash-lookup cl-builtin-gethash + cl-builtin-remhash cl-builtin-clrhash cl-builtin-maphash cl-gethash + ;;cl-puthash cl-remhash cl-clrhash + ;;cl-maphash + cl-hash-table-count + cl-prettyprint cl-do-prettyprint cl-macroexpand-cmacs cl-closure-vars + cl-macroexpand-all cl-macroexpand-body cl-prettyexpand)) + + + +;; oct.el + +(ignore-errors (require 'oct)) + +(erbutils-defalias-i + + + '( + oct-zeros oct-ones oct-sum oct-size + oct-rows oct-columns oct-\.* + oct-add + oct-corr oct-complement oct-sumsq oct-mean + oct-sqrt oct-std oct-tanh oct-atanh) + "" "oct-") + +(erbutils-defalias-i '(oct-/ oct-+ )) +(erbutils-defalias-i '(lsh)) +(erbutils-defalias-i '(obarray)) + + +;; files.el +(erbutils-defalias-i + '(auto-mode-alist interpreter-mode-alist + directory-abbrev-alist)) + + +(erbutils-defalias-i '(load-history)) +(erbutils-defalias-i '(assoc)) +(erbutils-defalias-i '(eq)) +(erbutils-defalias-i '(message)) +(erbutils-defalias-i '(decf)) +(erbutils-defalias-i '(incf)) +(erbutils-defalias-i '(faith-quote)) +(erbutils-defalias-i '(zerop)) +;;(erbutils-defalias-i '(buffer-substring)) +(erbutils-defalias-i '(buffer-substring-no-properties)) +;;(erbutils-defalias-i '(buffer-string)) + +;; We define it to be no-properties, else people can (setq foo +;; (buffer-string)).. and cause a huge uservariables file.. + +(defun fsi-buffer-string (&rest args) + (buffer-substring-no-properties (point-min) (point-max))) + +(defalias 'fsi-buffer-substring 'buffer-substring-no-properties) + + +(erbutils-defalias-i + '(featurep feature-symbols feature-file features + + )) +(erbutils-defalias-i + '(minor-mode-alist minor-mode-map-alist + minor-mode-overriding-map-alist)) +(erbutils-defalias-vars '(major-mode)) + +;; from gnus-group.el + +(erbutils-defalias-vars '(gnus-group-mode-map)) +(erbutils-defalias-vars '(gnus-summary-mode-map)) +(erbutils-defalias-vars '(message-mode-map)) +(erbutils-defalias-vars '(text-mode-map)) +(erbutils-defalias-vars '(emacs-lisp-mode-map)) +(erbutils-defalias-vars '(lisp-mode-map)) + +(erbutils-defalias-i '(boundp fboundp)) +(erbutils-defalias-i '(lookup-key)) +(erbutils-defalias-i '(minor-mode-key-binding)) + +(erbutils-defalias-i '(where-is-internal)) +(erbutils-defalias-i '(% abs)) + +(erbutils-defalias-i '(cdr cddr car cadr cdar)) +(erbutils-defalias-i '(erc-channel-list)) + +(when (ignore-errors (require 'units)) + (erbutils-defalias-i '(units-version units-load-hook units-dat-file + units-buffer units-s-to-n + units-prefix-convert + units-si-prefix-list + units-si-short-prefix-list + units-convert-1 units-convert))) + + +(defvar erbn-nicks-dead nil) + +(defun erbn-mark-dead (&rest ignore) + (let ((ni (format "%s" erbn-nick))) + (unless (string= ni "nil") + (add-to-list 'erbn-nicks-dead (format "%s" erbn-nick))))) + + + +;; allow people to mark themselves dead :-) +(defalias 'fsi-mark-dead 'erbn-mark-dead) + +(defun erbn-unmark-dead (nick) + (setq erbn-nicks-dead (remove (format "%s" nick) erbn-nicks-dead))) + + + +(defun erbn-dead-check (&rest ignore) + (when (fsi-dead-p erbn-nick) + (error "I see dead people! + .... (but I don't talk to them!)"))) + +(defalias 'fsi-dead-check 'erbn-dead-check) + +(defun erbn-dead-p (&optional nick) + (unless nick (setq nick erbn-nick)) + (member (format "%s" nick) erbn-nicks-dead)) + +(defalias 'fsi-dead-p 'erbn-dead-p) + + + +(defun fs-give (&optional nini &rest stuff) + (unless nini (setq nini "self")) + (when (string= "me" nini) + (setq nini nick)) + (unless stuff (setq stuff '("a" "beer"))) + (format "/me gives %s %s" + nini + (mapconcat + (lambda (arg) (format "%s" arg)) + stuff " "))) + + +(defalias 'fs-hand 'fs-give) + +(erbutils-defalias-i + '(backward-kill-sentence + backward-sentence + flame-sentence flame-sentence-ify + flame-sentence-loop forward-sentence kill-sentence + mark-end-of-sentence sentence-at-point sentence-end + sentence-end-double-space sentence-end-without-period + transpose-sentences)) + +(defalias 'fsi-flatten 'erbutils-flatten) + + + +(erbutils-defalias-i '(log)) +(erbutils-defalias-i + '(most-positive-fixnum + most-negative-fixnum)) + + + +(erbutils-defalias-i + '( + regexp-opt + regexp-opt-depth + regexp-opt-group regexp-opt-charset)) + +(erbutils-defalias-i '(window-system)) + + +(defvar erbot-kbd-p nil + "Whether to enable kbd. + +Note that making this non-nil can lead to vector results. For +example, (kbd \"<home>\"), (thanks to fledermaus).") + +(when (and + (not erbot-paranoid-p) + erbot-kbd-p + (erbutils-defalias-i + '(kbd read-kbd-macro)))) + +(defconst fs-t t + "As such, when we sandbox a lisp expression, t remains t, so this is +not needed. +However, inside macros like (cond (t....)), t becomes fs-t because +it occurs in an unusual place. this const should take care of it.. +Of course, this also opens the bot to some FUN user abuse, when they +setq fs-t to nil :-) ") + + +(defconst fs-nil nil + "See the doc of fs-t ") + + +(defun fsi-revive (&optional name &rest ignore) + (unless name (error "no one to revive")) + (setq name (format "%s" name)) + (let (ansstr) + (setq ansstr + (cond + ((string= name nick) + (concat "Thou idiot, " nick ", thou canst not revive thyself!")) + (t (concat + "/me sprinkles some " + (erbutils-random + '("clear" "murky" "boiling" "dark" "holy" "smelly")) + " potion on " + (format "%s" name) + " and utters some prayers. " + (erbutils-random + (list + (format "%s wakes up" name) + "Nothing happens." + (format "%s wakes up, all refreshed. " name) + (format "%s wakes up, all confused. " name) + )))))) + (when (string-match "wakes up" ansstr) + (erbn-unmark-dead name)) + ansstr)) + +;; this may be unsafe, remove it: +;; (defalias 'fs-sandbox-quoted 'erblisp-sandbox-quoted) +;; (defalias 'fs-sandbox-quoted-maybe 'erblisp-sandbox-quoted-maybe) +;; (defalias 'fs-sandbox 'erblisp-sandbox) + +(erbutils-defalias-i '(macroexpand)) + + +;;"/usr/share/emacs/21.2/lisp/emacs-lisp/pp.el" +(erbutils-defalias + '(pp-escape-newlines + pp-to-string + ;; pp pp-eval-expression + ;;pp-eval-last-sexp)) + )) + + +(erbutils-defalias-i '(string-match identity)) + +(erbutils-defalias-i '(parse-time-string)) + +(erbutils-defalias-i '(reverse)) + +(defun fsi-pp (object &rest ignore) + (pp object)) + + +(defmacro fs-privmsg (&rest args) + "This macro is carefully constructed so that one user cannot force a +query to another user. " + `(cond + ;; This can occur when you are requesting a parse.. + ((null erbn-nick) + (progn ,@args)) + (t + (progn + (setq erbn-tgt erbn-nick) + ;; If there isn't already a buffer, create one.. + (erbn-query erbn-nick) + ,@args)))) + +(defun erbn-query (qnick) + (save-excursion (erc-query qnick erbn-buffer))) + + + +(defun fsi-read-or-orig (arg) + " If string and can read, read, else return the arg. +Note: Used by fs-describe" + (cond + ((stringp arg) + (condition-case fs-tmp (erbn-read arg) + (error arg))) + (t arg))) + + +(defun erbn-read-from-string (str) + (let (str2) + (cond + ((stringp str) + (setq str2 (copy-sequence str)) + (set-text-properties 0 (length str2) nil str2) + (read-from-string str)) + (t (error "The bot will only read from strings. "))))) + + + +(defun erbn-read (str) + "Like read, but only from strings" + (car (erbn-read-from-string str))) + + +(defalias 'fsi-read 'erbn-read) +(defalias 'fsi-read-from-string 'erbn-read-from-string) + + +(erbutils-defalias-i + '(substring subr-arity subrp subseq + subst-char-in-string + subtract-time + time-subtract + time-add + date-to-time + time-to-seconds + time-less-p + seconds-to-time + days-to-time + time-since + subtract-time + date-to-day + days-between + date-leap-year-p + time-to-day-in-year time-to-days time-to-number-of-days + safe-date-to-time)) + + +(erbutils-defalias-i '(ignore)) + +(erbutils-defalias-i '(caar elt)) + +(provide 'erbc) +(run-hooks 'fs-after-load-hooks) + + + +;;; erbc.el ends here + diff --git a/elisp/erbot/erbc2.el b/elisp/erbot/erbc2.el new file mode 100644 index 0000000..2d84cbc --- /dev/null +++ b/elisp/erbot/erbc2.el @@ -0,0 +1,349 @@ +;;; erbc2.el --- mostly: special functions for erbc.el +;; Time-stamp: <2007-11-23 11:30:12 deego> +;; Copyright (C) 2003 D. Goel +;; Emacs Lisp Archive entry +;; Filename: erbc2.el +;; Package: erbc2 +;; Author: D. Goel <deego@gnufans.org> +;; Keywords: +;; Version: +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot + + + + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + + +;; this gile contains yet more functions for fs-. The functions +;; here shall tend to be "specially defined" ones. + + +(defconst erbc2-version "0.0dev") +;;========================================== +;;; Requires: +(eval-when-compile (require 'cl)) + +;;; Code: + +(defcustom erbc2-before-load-hooks nil + "Hooks to run before loading erbc2." + :group 'erbc2) +(defcustom erbc2-after-load-hooks nil + "Hooks to run after loading erbc2." + :group 'erbc2) +(run-hooks 'erbc2-before-load-hooks) + + +;;; Real Code: + +(defvar erbn-while-max 10000) +(defvar erbn-while-ctr 0) +(defmacro fs-while (cond &rest body) + `(let + ((erbn-while-ctr 0)) + (while + ,cond + ;; this should enable the with-timeout checks.. + (sleep-for 0.01) + (if (> erbn-while-ctr erbn-while-max) + (error "Max while iterations exceeded: %S" + erbn-while-ctr)) + (incf erbn-while-ctr) + nil + ,@body))) + + + +(defmacro fs-dotimes (spec &rest body) + `(dotimes + ,spec + (sleep-for 0.01) + nil + ,@body)) + + + + +(defun fsi-set-difference (a b) + (set-difference a b)) + + +(defun fsi-pp (&optional foo &rest bar) + (pp foo)) + + + + + + +(defvar erbn-tmp-avar nil) +(defvar erbn-tmp-newargs nil) + +(defun erbn-apply-sandbox-args-old (args) + (cond + ((= (length args) 0) nil) + ((= (length args) 1) + (if (equal (caar args) 'quote) args + (mapcar 'erblisp-sandbox-quoted args))) + (t + (cons (erblisp-sandbox-quoted (car args)) + (erbn-apply-sandbox-args (cdr args)))))) +(defun erbn-apply-sandbox-args (args) + (cond + ((not (listp args)) + (erblisp-sandbox args)) + ((= (length args) 0) nil) + (t + (mapcar 'erblisp-sandbox args)))) + +(defvar erbn-apptmpa) +(defvar erbn-apptmpb) +(defvar erbn-apptmpc) +(defvar erbn-apptmpd) +(defvar erbn-tmpsymbolp) + + +(defmacro fs-apply (fcnsym &rest args) + "" + (when erbot-paranoid-p + (error "This function is disabled: erbot-paranoid-p")) + (unless fcnsym (error "No function to fs-apply!")) + (let (erbn-tmpargs + (erbn-tmplen (length args)) + erbn-tmpfirstargs + erbn-lastargs + erbn-tmpspecialp ;; denotes: NIL: no arguments at all. + erbn-tmpnoinitialp ;; denotes the case when the len args =1.. + ) + (cond + ((= (length args) 0) + (setq erbn-tmpspecialp t)) + ((= (length args) 1) + (setq erbn-tmpnoinitialp t))) + (cond + ((null args) + (setq erbn-tmpargs nil) + (setq erbn-tmplastargs nil) + (setq erbn-tmpspecialp nil)) + (t + (setq erbn-tmpargs + (append (subseq args 0 (- erbn-tmplen 1)))) + (setq erbn-tmplastargs + (first (last args))))) + (setq erbn-tmpargs (erbn-apply-sandbox-args erbn-tmpargs)) + (setq erbn-tmplastargs + (if (and (listp erbn-tmplastargs) + (equal (car erbn-tmplastargs) 'quote)) + erbn-tmplastargs + (erbn-apply-sandbox-args erbn-tmplastargs))) + (cond + ((listp fcnsym) + (setq fcnsym (erblisp-sandbox-quoted fcnsym))) + ((symbolp fcnsym) + (setq fcnsym (erblisp-sandbox-quoted fcnsym))) + (t (error "No clue how to apply that. "))) + (cond + (erbn-tmpspecialp + `(apply (erblisp-sandbox-quoted ,fcnsym) nil)) + (erbn-tmpnoinitialp + `(apply (erblisp-sandbox-quoted ,fcnsym) ,erbn-tmplastargs)) + (t + `(apply (erblisp-sandbox-quoted ,fcnsym) ,@erbn-tmpargs ,erbn-tmplastargs))))) + + +;; (defmacro fs-apply-old (fcnsym &rest args) +;; (error "This function is old.") +;; (unless fcnsym (error "No function to fs-apply!")) +;; (let (erbn-tmpargs +;; (erbn-tmplen (length args)) +;; erbn-tmpnewargs +;; ) +;; (cond +;; ((null args) +;; (setq erbn-tmpargs nil)) +;; (t +;; (setq erbn-tmpargs +;; (append (subseq args 0 (- erbn-tmplen 1)) +;; (last args))))) + +;; (let* ( +;; (erbn-tmp-newargs (erbn-apply-sandbox-args erbn-tmpargs)) +;; (erbn-tmp-newlen (length erbn-tmp-newargs))) +;; (cond +;; ((listp fcnsym) +;; (setq fcnsym (erblisp-sandbox-quoted fcnsym))) +;; ((symbolp fcnsym) +;; (setq fcnsym (erblisp-sandbox-quoted fcnsym))) +;; (t (error "No clue how to apply that. "))) +;; `(let ((erbn-tmp-avar ,fcnsym)) +;; (cond +;; ((symbolp erbn-tmp-avar) +;; (setq erbn-tmp-avar +;; (erblisp-sandbox-quoted erbn-tmp-avar))) +;; (t "nada")) +;; ,(if (= erbn-tmp-newlen 0) +;; `(apply erbn-tmp-avar nil) +;; `(apply erbn-tmp-avar ,@erbn-tmp-newargs nil)))))) + + +(defmacro fs-funcall (symbol &rest args) + `(fs-apply ,symbol ,@args nil)) + + + +;; hm, what is this? Was it me? silly me.. Why did I do this?? +(defalias 'fs-function 'identity) + +(defvar erbn-read-mode nil) +(defvar erbn-read-input nil) + +(defvar fs-internal-botread-prompt "Enter: ") + +(defun fsi-botread (&optional prompt) + (unless prompt (setq prompt fs-internal-botread-prompt)) + (ignore-errors + (erbot-reply (concat prompt "") proc nick tgt msg nil)) + (setq fs-internal-botread-prompt "Enter: ") + (setq erbn-read-mode t) + (while + (not erbn-read-input) + (sleep-for 0.1) + (sit-for 0.1)) + (let ((input erbn-read-input)) + (setq erbn-read-input nil) + (setq erbn-read-mode nil) + input)) + +(defun fsi-dun-mprinc (str) + (ignore-errors + (erbot-reply str proc nick tgt msg nil)) + (setq fs-internal-botread-prompt str)) + +(defun fsi-botread-feed-internal (str) + (setq erbn-read-input str) + (format + "Thanks for feeding the read-line. Msg obtained: %s" + str) + (setq erbn-read-mode nil) + str) + + + +;; i love this thing.. just no time to finish this yet.. + +;;; (defvar erbn-calsmart-tmp-expr nil) +;;; (defvar erbn-calsmart-tmp-exprb nil) +;;; (defvar erbn-calsmart-tmp-exprc nil) +;;; (defvar erbn-calsmart-tmp-error nil) + +;;; (defmacro fs-calsmart (&rest exprs) +;; "This will insert parenthesis appropriately, so you can type stuff +;; like , c + 2 3 4 - 3 4 * 3 4 5 (- 2 3) +;; and fsbot will try parenthesis at appropriate places until the +;; resulting expression makes sense .. " +;;; (require 'choose) +;;; (case (length exprs) +;;; ((1) `(car ,exprs)) +;;; (t +;;; `(choose-with +;;; (let* ( +;;; (erbn-calsmart-tmp-expr expr) +;;; (erbn-calsmart-tmp-exprb +;;; (erbn-calsmart-break-expr erbn-calsmart-tmp-expr)) +;;; (erbn-calsmart-tmp-exprc +;;; (choose (list erbn-calsmart-expr +;;; erbn-calsmart-tmp-exprb))) +;;; ) +;;; (cond +;;; (erbn-calsmart-tmp-exprb +;;; (condition-case erbn-calsmart-tmp-error +;;; (eval erbn-calsmart-tmp-exprc) +;;; (error (choose-fail)))) +;;; ;; couldn't break.. just do the normal thing. +;;; (t (eval erbn-calsmart-tmp-expr)))))))) + + +;;; (defun erbn-calsmart-break-expr (expr) +;;; "Expr is a list, which we intend to break. WE prefer breaking such +;;; that the broken function gets 2 arguments. +;;; We want to rewrap everything by erbn-calsmart, so things get broken +;;; further.. + + + +(defun fsi-bash-specific-quote (&optional number &rest ignored) + "NUMBER need not be jsut NUMBER. Any argument to +bash-specific-quotes, like random, should work." + (require 'bash-quotes) + (let (aa bb bashstr) + (unless number + (setq number "random")) + (bash-specific-quote (format "%s" number)) + (sit-for 5) + ;; (let (aa bb) + ;; (set-buffer "*bash*") + ;; (goto-char (point-min)) + ;; (setq aa (search-forward "--------" nil t)) + ;; (forward-line 1) + ;; (setq aa (search-forward "--------" nil t)) + ;; (forward-line 1) + ;; (setq aa (point)) + ;; (setq bb (search-forward "--------" nil t)) + ;; (forward-line -1) + ;; (setq bb (point)) + ;; (when (and aa bb) + ;; (buffer-substring-no-properties aa bb))) + (set-buffer "*bash*") + (setq bashstr (erbutils-buffer-string)) + (with-temp-buffer + (insert bashstr) + (goto-char (point-min)) + (setq aa (search-forward-regexp "^--------" nil t)) + (forward-line 1) + (setq aa (search-forward-regexp "^--------" nil t)) + (forward-line 1) + (beginning-of-line) + (setq aa (point)) + (setq bb (search-forward-regexp "^--------" nil t)) + (forward-line -1) + (end-of-line) + (setq bb (point)) + (if (and aa bb) + (buffer-substring-no-properties aa bb) + "No result")))) + +(defalias 'fsi-bsc 'fs-bash-specific-quote) +(defalias 'fs-bash-quote 'fs-bash-specific-quote) +(defalias 'fs-bash.org 'fs-bash-specific-quote) +;;(defalias 'fs-bash 'fs-bash-specific-quote) + + + + + + +(defalias 'fsi-lexical-let 'lexical-let) +(provide 'erbc2) +(run-hooks 'erbc2-after-load-hooks) + + + +;;; erbc2.el ends here diff --git a/elisp/erbot/erbc3.el b/elisp/erbot/erbc3.el new file mode 100644 index 0000000..071345e --- /dev/null +++ b/elisp/erbot/erbc3.el @@ -0,0 +1,290 @@ +;;; erbc3.el ---erbot lisp stuff which should be PERSISTENT ACROSS SESSIONS. +;; Time-stamp: <2007-11-23 11:30:12 deego> +;; Copyright (C) 2003 D. Goel +;; Emacs Lisp Archive entry +;; Filename: erbc3.el +;; Package: erbc3 +;; Author: D. Goel <deego@gnufans.org> +;; Keywords: +;; Version: +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot +;; For latest version: + +(defconst erbc3-home-page + "http://gnufans.net/~deego") + + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +(defconst erbc3-version "0.dev") +(defun erbc3-version (&optional arg) + "Display erbc3's version string. +With prefix ARG, insert version string into current buffer at point." + (interactive "P") + (if arg + (insert (message "erbc3 version %s" erbc3-version)) + (message "erbc3 version %s" erbc3-version))) + +;;========================================== +;;; Requires: +(eval-when-compile (require 'cl)) + +;;; Code: + +(defgroup erbc3 nil + "The group erbc3." + :group 'applications) +(defcustom erbc3-before-load-hook nil + "Hook to run before loading erbc3." + :group 'erbc3) +(defcustom erbc3-after-load-hook nil + "Hook to run after loading erbc3." + :group 'erbc3) +(run-hooks 'erbc3-before-load-hook) + + +;;; Real Code: +;; pf stands for persistent functions. +;; pv stands for persistent variables. + +(defvar erbn-pf-file "~/public_html/data/userfunctions.el") +(defvar erbn-pv-file "~/public_html/data/uservariables.el") + +(defun fsi-pfpv-load () + (fsi-pf-load) + (fsi-pv-load)) + +(defun fsi-pf-load () + (if (file-exists-p erbn-pf-file) + (fsi-ignore-errors-else-string (load erbn-pf-file)) + (message "File does not exist: %s" erbn-pf-file))) + + + +(defun fsi-pv-load () + (when (file-exists-p erbn-pv-file) + (ignore-errors (load erbn-pv-file)))) + + + +(defun fsi-user-function-p (fcn) + (member + fcn + (erbutils-functions-in-file erbn-pf-file))) + + +(defun erbn-create-defun-new (sexps body) + (cons body sexps)) + +(defun erbn-create-defun-overwrite (sexps body fcn) + (cons body + (remove + (first (member-if + (lambda (arg) (equal (second arg) fcn)) + sexps)) + sexps))) + + + +(defun erbn-write-sexps-to-file (file sexps &optional backup-rarity) + (unless backup-rarity (setq backup-rarity 1)) + (when (zerop (random backup-rarity)) (erbutils-mkback-maybe file)) + + (find-file file) + (widen) + (delete-region (point-min) (point-max)) + (insert "\n\n\n") + (insert + (mapconcat + (lambda (arg) (pp-to-string arg)) sexps "\n\n\n")) + (insert "\n\n\n") + (save-buffer)) + +(defvar erbn-tmp-sexps) +(defvar erbn-tmp-newbody) + + + + + + + + + +(defun fsi-pv-get-variables-values () + (let + ((vars + (apropos-internal "^fs-" 'boundp))) + (mapcar + (lambda (v) + `(ignore-errors + (defvar ,v + (quote ,(eval v))))) + vars))) + + +(defcustom fs-pv-save-rarity 100000 + "if this is 1000, then file is saved one in a thousand times... ") + +;;;###autoload +(defun fsi-pv-save () + (interactive) + (erbn-write-sexps-to-file + erbn-pv-file + (fs-pv-get-variables-values) 1000)) + ;; this should lead to a few saves every day... not too many, one hopes.. +;;1000)) + + + +(defun erbn-readonly-check (sym) + (if (get sym 'readonly) + (error "The symbol %S can't be redefined or set! It is read-only!" + sym))) + + + + +(defmacro fsi-defun (fcn args &rest body) + + ;; the given fcn icould be a number or string, in which + ;; case sandboxing won't touch it, so we need to override that case. + (let ((docp nil)) + (unless + (and (listp body) + (> (length body) 0)) + (error "Function body should have a length of 1 or more")) + (unless (and (symbolp fcn) (not (fsi-constant-object-p fcn))) + (error "Defun symbols only! :P")) + ;; doc string exists, and is followed by more stuff.. + (when (and (> (length body) 1) + (stringp (first body))) + (setq docp t)) + (erbn-readonly-check fcn) + + (erbn-write-sexps-to-file + erbn-pf-file + (erbn-create-defun-overwrite + (erbutils-file-sexps erbn-pf-file) + (if docp + + (cons 'defun + (cons fcn + (cons args + (cons + (first body) + (cons + `(erblisp-check-args ,@args) + (cons + '(sit-for 0) + (cdr body))))))) + + (cons 'defun + (cons fcn + (cons args + (cons + `(erblisp-check-args ,@args) + (cons + '(sit-for 0) + body)))))) + + fcn)) + (fsi-pf-load) + `(quote ,fcn))) + + + + + +(defun fsi-defalias (sym1 sym2) + (eval `(fsi-defun + ,(erblisp-sandbox-quoted sym1) (&rest fs-bar) + (fs-apply (quote ,(erblisp-sandbox-quoted sym2)) fs-bar)))) + + + + + + + + + + +(defun fsi-makunbound (&optional sym) + (unless sym (error "Syntax: , (makunbound 'symbol)")) + (setq sym + (erblisp-sandbox sym)) + (makunbound sym)) + + +(defun fsi-fmakunbound (&optional sym) + (unless sym (error "Syntax: , (fmakunbound 'symbol)")) + + (setq sym + (erblisp-sandbox sym)) + + (erbn-readonly-check sym) + + (let + ;; this is to be returned.. + ((result (fmakunbound sym)) + (sexps (erbutils-file-sexps erbn-pf-file))) + + ;; now we want to remove any definition of sym from the user + ;; file: + + (erbn-write-sexps-to-file + erbn-pf-file + (remove + (first + (member-if + (lambda (arg) (equal (second arg) sym)) + sexps)) + sexps)) + (fsi-pf-load) + result)) + + +(defvar erbn-tmpsetq nil) + +(defmacro fsi-setq (&rest args) + `(let ((erbn-tmpsetq + (setq ,@args))) + (fs-pv-save) + erbn-tmpsetq)) + + + +(defun fsi-constant-object-p (object) + "If the object is a symbol like nil or t, a symbol that cannot be +redefunned, return true. " + (or (member object (list nil t)) + (keywordp object))) + + + +(erbutils-defalias-i '(type-of)) + +(provide 'erbc3) +(run-hooks 'erbc3-after-load-hook) + + + +;;; erbc3.el ends here diff --git a/elisp/erbot/erbc4.el b/elisp/erbot/erbc4.el new file mode 100644 index 0000000..240b9a5 --- /dev/null +++ b/elisp/erbot/erbc4.el @@ -0,0 +1,333 @@ +;;; erbc4.el --- Russian Roulette +;; Time-stamp: <2007-11-23 11:30:12 deego> +;; Copyright (C) 2003 Taylor Campbell +;; Emacs Lisp Archive entry +;; Filename: erbc4.el +;; Package: erbc4 +;; Author: Taylor Campbell +;; Keywords: +;; Version: +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot +;; For latest version: + +(defconst erbc4-home-page + "http://gnufans.net/~deego") + + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +(defconst erbc4-version "0.0dev") + + +;;========================================== +;;; Requires: +(eval-when-compile (require 'cl)) + +;;; Code: + +;;; Real Code: + +(defvar erbn-RR-empty-bets (make-hash-table)) +(defvar erbn-RR-bullet-bets (make-hash-table)) +(defvar erbn-money (make-hash-table)) + +(defun erbn-move-money (nick table1 table2 amount) + (let ((cell1 (gethash nick table1)) + (cell2 (gethash nick table2))) + (if cell1 + (decf (gethash nick table1) amount) + (setf (gethash nick table1) (- amount))) + (if cell2 + (incf (gethash nick table2) amount) + (setf (gethash nick table2) amount)))) + +(defun fs-bet (&rest args) + (let ((nick (intern nick))) + (cond ((null args) + (let ((empty-bet (gethash nick erbn-RR-empty-bets)) + (bullet-bet (gethash nick erbn-RR-bullet-bets))) + (cond (empty-bet + (format "%s has bet %d on there being no bullet." + nick empty-bet)) + (bullet-bet + (format "%s has bet %d on there being a bullet." + nick bullet-bet)) + (t (format "%s has not bet anything." + nick))))) + ((and (consp args) + (consp (cdr args)) + (null (cddr args)) + (cond ((symbolp (car args)) + (numberp (cadr args))) + ((numberp (car args)) + (symbolp (cadr args))) + (t nil))) + (let* ((on-what (if (symbolp (car args)) (car args) (cadr args))) + (how-much (if (numberp (car args)) (car args) (cadr args))) + (_ (if (< how-much 0) + (error "You can't bet negative amounts, moron."))) + (table (case on-what + ((empty no-bullet click) erbn-RR-empty-bets) + ((bullet bang blam) erbn-RR-bullet-bets) + (t (error "Invalid bet type" on-what)))) + (not-table (if (eq table erbn-RR-bullet-bets) + erbn-RR-empty-bets + erbn-RR-bullet-bets))) + (cond ((gethash nick not-table) + (format "%s: Idiot, you can can only bet on one outcome." + nick on-what)) + ((< (or (gethash nick erbn-money) 0) how-much) + (format + "%s: Fool, you can't bet more than you've got (%d)." + nick (or (gethash nick erbn-money) 0))) + (t (erbn-move-money nick erbn-money table how-much) + (format "%s has bet %d GEMs so far on a %s." + nick + (gethash nick table) + on-what))))) + (t (error "Invalid arguments to bet" args))))) + +(defun fs-lend (arg1 arg2 &rest ignored) + (let* ((to-whom (if (symbolp arg1) arg1 arg2)) + (how-much (if (numberp arg2) arg2 arg1)) + (nick (intern nick)) + (money (gethash nick erbn-money))) + (if (equal nick to-whom) + (error "You can't lend money to yourself, knave!")) + (if (> how-much money) + (error "You can't lend more than you have" nick how-much)) + (if (< how-much 0) + (error "You can't lend negative amounts.")) + (decf (gethash nick erbn-money) how-much) + (if (gethash to-whom erbn-money) + (incf (gethash to-whom erbn-money) how-much) + (setf (gethash to-whom erbn-money) how-much)) + (format "%s has lent %d GEMs to %s; %s now has %d GEMs and %s %d." + nick + how-much + to-whom + + nick + (gethash nick erbn-money) + + to-whom + (gethash to-whom erbn-money)))) + +(defun erbn-keyshash (hash-table) + (let ((keys nil)) + (maphash (lambda (key val) (push key keys)) hash-table) + keys)) + +(defun erbn-valueshash (hash-table) + (let ((values nil)) + (maphash (lambda (key val) (push val values)) hash-table) + values)) + +(defun erbn-all-money (nick) + (let ((amount + (apply #'+ + (mapcar (lambda (table) + (or (gethash nick table) 0)) + (list erbn-money + erbn-RR-bullet-bets + erbn-RR-empty-bets))))) + (mapc (lambda (table) + (remhash nick table)) + (list erbn-money + erbn-RR-bullet-bets + erbn-RR-empty-bets)) + amount)) + +(defun fs-money (&optional maybe-nick) + (let* ((local-nick (or (and maybe-nick + (if (symbolp maybe-nick) + maybe-nick + (intern maybe-nick))) + (intern nick))) + (amount (or (gethash local-nick erbn-money) 0))) + (if maybe-nick + (format "%s has %d GEMs." + local-nick + amount) + (format "You've got %d GEMs, %s." + amount + nick)))) + +(defun erbn-percent (m n) + (/ (* (float m) 100.0) (float n))) + +(defun erbn-unpercent (m n) + (/ (* (float m) (float n)) 100.0)) + + +(defun erbn-distribute (maybe-dead-nick winning-table losing-table) + (prog1 (cond ((and (= (hash-table-count winning-table) 0) + (not maybe-dead-nick)) + ;; Give the losers their money back. + (maphash (lambda (nick amount) + (incf (gethash nick erbn-money) amount)) + losing-table)) + ((and (= (hash-table-count losing-table) 0) + (not maybe-dead-nick)) + ;; Give the winners their money back. + (maphash (lambda (nick amount) + (incf (gethash nick erbn-money) amount)) + winning-table)) + (t (let* ((winning-bets (erbn-valueshash winning-table)) + (total-win-bets (apply #'+ winning-bets)) + (total-money + (apply #'+ + (if maybe-dead-nick + (erbn-all-money maybe-dead-nick) + 0) + total-win-bets + (erbn-valueshash losing-table)))) + (maphash (lambda (nick amount) + (let* ((percent + (erbn-percent amount total-win-bets)) + (unpercent + (erbn-unpercent percent + total-money))) + (incf (gethash nick erbn-money) + (round unpercent)))) + winning-table)))) + (clrhash winning-table) + (clrhash losing-table))) + +(defvar erbn-chamber (random 6)) + +;; Someone tell Riastradh if this is a good way to do this... (the +;; click and bang messages) +(defvar erbn-rr-bangs + (list (lambda () + (concat "/me blows " nick "'s cerebellum all over " + tgt "... *BANG*")) + (lambda () + (concat "/me blows " nick "'s brains all over " + tgt "... *BANG* ...reloading.")) + (lambda () + (concat nick " has to pick his brains off of the walls and " + " floor... *BANG*")) + (lambda () + (concat nick "'s luck just ran out... *BANG*")) + (lambda () + (concat "/me offers " nick " a cold " + (fs-describe "beer-data") + " before giving him the fatal blow... *KABLAM*")))) +(defvar erbn-rr-clicks + (list (lambda () + (concat "/me points the gnu and " nick + " trembles... *CLICK*")) + (lambda () + (concat nick " shudders as the great and powerful fsbot aims " + "the all-powerful barrel of the gnu... *CLICK*")) + (lambda () + (concat nick " is one lucky punk... *CLICK*")) + (lambda () + (concat "/me picks up the gnu and points it at " nick + "'s head... *CLICK*")) + (lambda () + (concat "/me raises the gnu to " nick "'s head and " nick + " trembles as the *CLICK* sounds.")))) + +(defun erbn-rr-bang () + (fs-kick erbn-nick "*KABLAM!* Goop from your head dribbles.") + (funcall (fs-random-choose erbn-rr-bangs))) + +(defun erbn-rr-click () + (funcall (fs-random-choose erbn-rr-clicks))) + +(defun fs-add-bang (&rest bangs) + (setq erbn-rr-bangs + (concat bangs erbn-rr-bangs))) +(defun fs-add-click (&rest clicks) + (setq erbn-rr-clicks + (concat clicks erbn-rr-clicks))) + +(defun fs-russian-roulette (&rest ignored) + ;; Don't let them do that, because it confuses the money distribution. + (if (gethash (intern nick) erbn-RR-bullet-bets) + (error (concat nick ": Idiot, don't bet on your own death.")) + (if (= erbn-chamber 5) + (progn + (setq erbn-chamber (random 6)) + (erbn-distribute (intern nick) + erbn-RR-bullet-bets + erbn-RR-empty-bets) + (erbn-rr-bang)) + (incf erbn-chamber) + (erbn-distribute nil + erbn-RR-empty-bets + erbn-RR-bullet-bets) + (erbn-rr-click)))) + +(defvar erbn-auth-bankers + '(deego Riastradh fledermaus _sprintf)) + + +(defun erbn-add-banker (nick &rest ignored) + (add-to-list 'erbn-auth-bankers nick)) + +(defun fs-auth-bankerp () + (and (member (intern nick) erbn-auth-bankers) t)) + +(defun fs-reset-money (&rest ignored) + (if (not (fs-auth-bankerp)) + (error (concat nick ": You can't reset the money."))) + (clrhash erbn-money) + (clrhash erbn-RR-empty-bets) + (clrhash erbn-RR-bullet-bets) + "Money cleared.") + +(defun fs-init-money (init &rest nicks) + (if (not (fs-auth-bankerp)) + (error (concat nick ": you can't initialize the money"))) + (mapc (lambda (nick) + (setf (gethash (if (stringp nick) + (intern nick) + nick) + erbn-money) + init)) + nicks) + "Money initialized.") + +;; (defvar erbn-rr-bullet (random 6)) + +;; (defun fs-russian-roulette (&rest ignore) +;; (if (>= erbn-rr-bullet 5) +;; (progn +;; (setq erbn-rr-bullet (random 6)) +;; (fs-describe "rr-bang-kick")) +;; (incf erbn-rr-bullet) (fs-describe "rr-click"))) + +(defalias 'fsi-RR 'fs-russian-roulette) +(defalias 'fsi-rr 'fs-russian-roulette) + + +(defun fsi-kick (&optional reason &rest ignore) + (erbn-mark-dead) + (erc-cmd-KICK erbn-nick (when reason (format "%s" reason)))) + +(provide 'erbc4) +(run-hooks 'erbc4-after-load-hook) + + + +;;; erbc4.el ends here diff --git a/elisp/erbot/erbc5.el b/elisp/erbot/erbc5.el new file mode 100644 index 0000000..6c663aa --- /dev/null +++ b/elisp/erbot/erbc5.el @@ -0,0 +1,192 @@ +;;; erbc5.el --- continuation of erbc.el +;; Time-stamp: <2007-11-23 11:30:12 deego> +;; Copyright (C) 2003 D. Goel +;; Emacs Lisp Archive entry +;; Filename: erbc5.el +;; Package: erbc5 +;; Author: D. Goel <deego@gnufans.org> +;; Keywords: +;; Version: +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot +;; For latest version: + +(defconst erbc5-home-page + "http://gnufans.net/~deego") + + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +;; See also: + + +(defconst erbc5-version "0.0dev") +;;========================================== +;;; Requires: +(eval-when-compile (require 'cl)) + +;;; Code: + +(defgroup erbc5 nil + "The group erbc5." + :group 'applications) +(defcustom erbc5-before-load-hook nil + "Hook to run before loading erbc5." + :group 'erbc5) +(defcustom erbc5-after-load-hook nil + "Hook to run after loading erbc5." + :group 'erbc5) +(run-hooks 'erbc5-before-load-hook) + +(defcustom erbc5-verbosity 0 + "How verbose to be. +Once you are experienced with this lib, 0 is the recommended +value. Values between -90 to +90 are \"sane\". The +rest are for debugging." + :type 'integer + :group 'erbc5) +(defcustom erbc5-interactivity 0 + "How interactive to be. +Once you are experienced with this lib, 0 is the recommended +value. Values between -90 and +90 are \"sane\". The rest are for +debugging." + :type 'integer + :group 'erbc5) +(defcustom erbc5-y-or-n-p-function 'erbc5-y-or-n-p + "Function to use for interactivity-dependent `y-or-n-p'. +Format same as that of `erbc5-y-or-n-p'." + :type 'function + :group 'erbc5) +(defcustom erbc5-n-or-y-p-function 'erbc5-y-or-n-p + "Function to use for interactivity-dependent `n-or-y-p'. +Format same as that of `erbc5-n-or-y-p'." + :type 'function + :group 'erbc5) +(defun erbc5-message (points &rest args) + "Signal message, depending on POINTS anderbc5-verbosity. +ARGS are passed to `message'." + (unless (minusp (+ points erbc5-verbosity)) + (apply #'message args))) +(defun erbc5-y-or-n-p (add prompt) + "Query or assume t, based on `erbc5-interactivity'. +ADD is added to `erbc5-interactivity' to decide whether +to query using PROMPT, or just return t." + (if (minusp (+ add erbc5-interactivity)) + t + (funcall 'y-or-n-p prompt))) +(defun erbc5-n-or-y-p (add prompt) + "Query or assume t, based on `erbc5-interactivity'. +ADD is added to `erbc5-interactivity' to decide whether +to query using PROMPT, or just return t." + (if (minusp (+ add erbc5-interactivity)) + nil + (funcall 'y-or-n-p prompt))) + +;;; Real Code: + +(defalias 'fsi-listp-proper 'erbutils-listp-proper) +(erbutils-defalias-i '(upcase downcase capitalize upcase-initials)) + + + +(ignore-errors (require 'calc)) + +(defvar erbn-calc-time 3) +(defcustom erbn-calc-p nil + "Enable this variable at your own risk. +Enabling this means that fsbot will do calc operations, but those have +no timeout build in... leading to DOS attacks. ") + + +(defun fsi-calc-eval (&optional str) + " +Note that even though this function has a with-timeout built into it, +that doesn't save us from a DOS attack..since emacs polls only when +waiting for user input.. + +which is why turned off by default. + +" + (unless (and erbn-calc-p (not erbot-paranoid-p)) + (error "Sorry, but i am a bot! not a calc!")) + (unless str (error "Eval what?")) + (unless (stringp str) + (setq str (format "%s" str))) + (with-timeout + (erbn-calc-time "That's WAY too much math for me!") + (calc-eval str))) + +(defalias 'fs-calc 'fs-calc-eval) + +(erbutils-defalias '(process-list)) +(defalias 'fs-list-processes 'fs-process-list) + +(defcustom erbn-sregex-p nil + "Nil by default for safety. Enable to permit fs-sregex. +I think it is safe, but not 100% sure, so disabled by default. --DG" + ) + + +(defun fsi-sreg (&rest args) + (format "%S" + (apply 'fs-sregex args))) + + +(defun fsi-sregex (&rest args) + (cond + ((and erbn-sregex-p (not erbot-paranoid-p)) + (apply 'sregex args)) + (t + (error "sregexp is disabled in this bot. ")))) + + + +(defmacro fsi-ignore-errors-else-string (&rest body) + "Like ignore-errors, but tells and returns the erros. +\(Improved for me by Kalle on 7/3/01:)" + (let ((err (gensym))) + `(condition-case ,err (progn ,@body) + (error + (let + ((str + (message "IGNORED ERROR: %s" (error-message-string ,err)))) + (ding t) + (ding t) + (ding t) + (sit-for 1) + str))))) + + +;; more math functions +(erbutils-defalias-i '(mod)) +;; these from cl-extra +(erbutils-defalias-i '(isqrt floor* ceiling* round* mod* rem* signum + random*)) + + +(erbutils-defalias-i '(symbol-name)) + + + +(provide 'erbc5) +(run-hooks 'erbc5-after-load-hook) + + + +;;; erbc5.el ends here diff --git a/elisp/erbot/erbc6.el b/elisp/erbot/erbc6.el new file mode 100644 index 0000000..0de78e3 --- /dev/null +++ b/elisp/erbot/erbc6.el @@ -0,0 +1,75 @@ +;;; erbc6.el --- fsbot functions contributed by freenode users, esp. #emacsers. +;; Time-stamp: <2007-11-23 11:30:12 deego> +;; Copyright (C) 2003 D. Goel +;; Emacs Lisp Archive entry +;; Filename: erbc6.el +;; Package: erbc6 +;; Author: D. Goel <deego@gnufans.org> and #emacsers +;; Keywords: +;; Version: +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot +;; For latest version: +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +;;; Real Code: + + + +(defun fs-m8b nil + (fs-random-choose + '("Yes" "No" "Definitely" "Of course not!" "Highly likely." + "Ask yourself, d\o you really want to know?" + "I'm telling you, you don't want to know." "mu!"))) + + + +(defun fsi-C-h (sym &rest thing) + " +;;; 2003-08-16 T15:19:00-0400 (Saturday) D. Goel +Coded by bojohann on #emacs." + (cond + ((eq sym 'f) + (apply 'fs-df thing)) + ((eq sym 'k) + (apply 'fs-dk thing)) + ((eq sym 'c) + (apply 'fs-describe-key-briefly thing)) + ((eq sym 'w) + (apply 'fs-dw thing)) + ((eq sym 'v) + (apply 'fs-dv thing)))) + + +(defun fsi-wtf-is (&optional term &rest args) + (unless term + (error "Syntax: wtf TERM")) + (require 'wtf) + (funcall 'wtf-is (format "%s" term))) + + + +(defalias 'fsi-wtf 'fsi-wtf-is) + + +(provide 'erbc6) +(run-hooks 'erbc6-after-load-hook) + + + +;;; erbc6.el ends here diff --git a/elisp/erbot/erbcompat.el b/elisp/erbot/erbcompat.el new file mode 100644 index 0000000..8e9e518 --- /dev/null +++ b/elisp/erbot/erbcompat.el @@ -0,0 +1,55 @@ +;;; erbcompat.el --- Erbot GNU Emacs/XEmacs compatibility issues +;; Time-stamp: <2007-11-23 11:30:12 deego> +;; Copyright (C) 2004 S. Freundt +;; Emacs Lisp Archive entry +;; Filename: erbcompat.el +;; Package: erbot +;; Author: Sebastian Freundt <freundt@math.TU-Berlin.DE> +;; Version: NA +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot + + + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +(defvar erbot-on-xemacs-p nil + "Whether erbot is run on xemacs.") + +(setq erbot-on-xemacs-p + (and (string-match "xemacs" emacs-version) t)) + + +;;; local-variable-p stuff +(or (and erbot-on-xemacs-p + (defun erbcompat-local-variable-p (variable &optional buffer) + "Just in compatibilty to GNU Emacs" + (local-variable-p variable (or buffer (current-buffer))))) + (defalias 'erbcompat-local-variable-p 'local-variable-p)) + +;;; help-xref stuff +(and erbot-on-xemacs-p + (defun help-setup-xref (&rest ignore)) + (defun help-xref-button (&rest ignore)) + (defun help-xref-stack (&rest ignore))) + + +(provide 'erbcompat) + +;; erbcompat.el ends here diff --git a/elisp/erbot/erbcountry.el b/elisp/erbot/erbcountry.el new file mode 100644 index 0000000..3e2d717 --- /dev/null +++ b/elisp/erbot/erbcountry.el @@ -0,0 +1,518 @@ +;; 2003-02-13 T13:36:31-0500 (Thursday) D. Goel +;; countries list is copied from http://www.iana.org/cctld/cctld-whois.htm +;;; Real Code: + +(defvar erbcountry-list) +(defvar erbcountry-string) + + +;; This is an incomplete, old list. We don't want to spend time to +;; create it again, so we will simply dump the contents into +;; erbcountry-string and use a routine to alistify that. +(unless (boundp 'erbcountry-list) + (setq erbcountry-list + '( + (".ac" "Ascension Island") + (".ad" "Andorra") + (".ae" "United Arab Emirates") + (".af" "Afghanistan") + (".ag" "Antigua and Barbuda") + (".ai" "Anguilla") + (".al" "Albania") + (".am" "Armenia") + (".an" "Netherlands Antilles") + (".ao" "Angola") + (".aq" "Antarctica") + (".ar" "Argentina") + (".as" "American Samoa") + (".at" "Austria") + (".au" "Australia") + (".aw" "Aruba") + (".az" "Azerbaijan") + (".ba" "Bosnia and Herzegovina") + (".bb" "Barbados") + (".bd" "Bangladesh") + (".be" "Belgium") + (".bf" "Burkina Faso") + (".bg" "Bulgaria") + (".bh" "Bahrain") + (".bi" "Burundi") + (".bj" "Benin") + (".bm" "Bermuda") + (".bn" "Brunei Darussalam") + (".bo" "Bolivia") + (".br" "Brazil") + (".bs" "Bahamas") + (".bt" "Bhutan") + (".bv" "Bouvet Island") + (".bw" "Botswana") + (".by" "Belarus") + (".bz" "Belize") + (".ca" "Canada") + (".cc" "Cocos (Keeling) Islands") + (".cd" "Congo, Democratic Republic of the") + (".cf" "Central African Republic") + (".cg" "Congo, Republic of") + (".ch" "Switzerland") + (".ci" "Cote d'Ivoire") + (".ck" "Cook Islands") + (".cl" "Chile") + (".cm" "Cameroon") + (".cn" "China") + (".co" "Colombia") + (".cr" "Costa Rica") + (".cu" "Cuba") + (".cv" "Cap Verde") + (".cx" "Christmas Island") + (".cy" "Cyprus") + (".cz" "Czech Republic") + (".de" "Germany") + (".dj" "Djibouti") + (".dk" "Denmark") + (".dm" "Dominica") + (".do" "Dominican Republic") + (".dz" "Algeria") + (".ec" "Ecuador") + (".ee" "Estonia") + (".eg" "Egypt") + (".eh" "Western Sahara") + (".er" "Eritrea") + (".es" "Spain") + (".et" "Ethiopia") + (".fi" "Finland") + (".fj" "Fiji") + (".fk" "Falkland Islands (Malvina)") + (".fm" "Micronesia, Federal State of") + (".fo" "Faroe Islands") + (".fr" "France") + (".ga" "Gabon") + (".gd" "Grenada") + (".ge" "Georgia") + (".gf" "French Guiana") + (".gg" "Guernsey") + (".gh" "Ghana") + (".gi" "Gibraltar") + (".gl" "Greenland") + (".gm" "Gambia") + (".gn" "Guinea") + (".gp" "Guadeloupe") + (".gq" "Equatorial Guinea") + (".gr" "Greece") + (".gs" "South Georgia and the South Sandwich Islands") + (".gt" "Guatemala") + (".gu" "Guam") + (".gw" "Guinea-Bissau") + (".gy" "Guyana") + (".hk" "Hong Kong") + (".hm" "Heard and McDonald Islands") + (".hn" "Honduras") + (".hr" "Croatia/Hrvatska") + (".ht" "Haiti") + (".hu" "Hungary") + (".id" "Indonesia") + (".ie" "Ireland") + (".il" "Israel") + (".im" "Isle of Man") + (".in" "India") + (".io" "British Indian Ocean Territory") + (".iq" "Iraq") + (".ir" "Iran (Islamic Republic of)") + (".is" "Iceland") + (".it" "Italy") + (".je" "Jersey") + (".jm" "Jamaica") + (".jo" "Jordan") + (".jp" "Japan") + (".ke" "Kenya") + (".kg" "Kyrgyzstan") + (".kh" "Cambodia") + (".ki" "Kiribati") + (".km" "Comoros") + (".kn" "Saint Kitts and Nevis") + (".kp" "Korea, Democratic People's Republic") + (".kr" "Korea, Republic of") + (".kw" "Kuwait") + (".ky" "Cayman Islands") + (".kz" "Kazakhstan") + (".la" "Lao People's Democratic Republic") + (".lb" "Lebanon") + (".lc" "Saint Lucia") + (".li" "Liechtenstein") + (".lk" "Sri Lanka") + (".lr" "Liberia") + (".ls" "Lesotho") + (".lt" "Lithuania") + (".lu" "Luxembourg") + (".lv" "Latvia") + (".ly" "Libyan Arab Jamahiriya") + (".ma" "Morocco") + (".mc" "Monaco") + (".md" "Moldova, Republic of") + (".mg" "Madagascar") + (".mh" "Marshall Islands") + (".mk" "Macedonia, Former Yugoslav Republic") + (".ml" "Mali") + (".mm" "Myanmar") + (".mn" "Mongolia") + (".mo" "Macau") + (".mp" "Northern Mariana Islands") + (".mq" "Martinique") + (".mr" "Mauritania") + (".ms" "Montserrat") + (".mt" "Malta") + (".mu" "Mauritius") + (".mv" "Maldives") + (".mw" "Malawi") + (".mx" "Mexico") + (".my" "Malaysia") + (".mz" "Mozambique") + (".na" "Namibia") + (".nc" "New Caledonia") + (".ne" "Niger") + (".nf" "Norfolk Island") + (".ng" "Nigeria") + (".ni" "Nicaragua") + (".nl" "Netherlands") + (".no" "Norway") + (".np" "Nepal") + (".nr" "Nauru") + (".nu" "Niue") + (".nz" "New Zealand") + (".om" "Oman") + (".pa" "Panama") + (".pe" "Peru") + (".pf" "French Polynesia") + (".pg" "Papua New Guinea") + (".ph" "Philippines") + (".pk" "Pakistan") + (".pl" "Poland") + (".pm" "St. Pierre and Miquelon") + (".pn" "Pitcairn Island") + (".pr" "Puerto Rico") + (".ps" "Palestinian Territories") + (".pt" "Portugal") + (".pw" "Palau") + (".py" "Paraguay") + (".qa" "Qatar") + (".re" "Reunion Island") + (".ro" "Romania") + (".ru" "Russian Federation") + (".rw" "Rwanda") + (".sa" "Saudi Arabia") + (".sb" "Solomon Islands") + (".sc" "Seychelles") + (".sd" "Sudan") + (".se" "Sweden") + (".sg" "Singapore") + (".sh" "St. Helena") + (".si" "Slovenia") + (".sj" "Svalbard and Jan Mayen Islands") + (".sk" "Slovak Republic") + (".sl" "Sierra Leone") + (".sm" "San Marino") + (".sn" "Senegal") + (".so" "Somalia") + (".sr" "Suriname") + (".st" "Sao Tome and Principe") + (".sv" "El Salvador") + (".sy" "Syrian Arab Republic") + (".sz" "Swaziland") + (".tc" "Turks and Caicos Islands") + (".td" "Chad") + (".tf" "French Southern Territories") + (".tg" "Togo") + (".th" "Thaila") + (".us" "USA") + + + ))) + + + +(unless (boundp 'erbcountry-string) + (setq erbcountry-string + ".ac Ascension Island +.ad Andorra +.ae United Arab Emirates +.af Afghanistan +.ag Antigua and Barbuda +.ai Anguilla +.al Albania +.am Armenia +.an Netherlands Antilles +.ao Angola +.aq Antarctica +.ar Argentina +.as American Samoa +.at Austria +.au Australia +.aw Aruba +.ax Aland Islands +.az Azerbaijan +.ba Bosnia and Herzegovina +.bb Barbados +.bd Bangladesh +.be Belgium +.bf Burkina Faso +.bg Bulgaria +.bh Bahrain +.bi Burundi +.bj Benin +.bm Bermuda +.bn Brunei Darussalam +.bo Bolivia +.br Brazil +.bs Bahamas +.bt Bhutan +.bv Bouvet Island +.bw Botswana +.by Belarus +.bz Belize +.ca Canada +.cc Cocos (Keeling) Islands +.cd Congo, The Democratic Republic of the +.cf Central African Republic +.cg Congo, Republic of +.ch Switzerland +.ci Cote d'Ivoire +.ck Cook Islands +.cl Chile +.cm Cameroon +.cn China +.co Colombia +.cr Costa Rica +.cs Serbia and Montenegro +.cu Cuba +.cv Cape Verde +.cx Christmas Island +.cy Cyprus +.cz Czech Republic +.de Germany +.dj Djibouti +.dk Denmark +.dm Dominica +.do Dominican Republic +.dz Algeria +.ec Ecuador +.ee Estonia +.eg Egypt +.eh Western Sahara +.er Eritrea +.es Spain +.et Ethiopia +.fi Finland +.fj Fiji +.fk Falkland Islands (Malvinas) +.fm Micronesia, Federal State of +.fo Faroe Islands +.fr France +.ga Gabon +.gb United Kingdom +.gd Grenada +.ge Georgia +.gf French Guiana +.gg Guernsey +.gh Ghana +.gi Gibraltar +.gl Greenland +.gm Gambia +.gn Guinea +.gp Guadeloupe +.gq Equatorial Guinea +.gr Greece +.gs South Georgia and the South Sandwich Islands +.gt Guatemala +.gu Guam +.gw Guinea-Bissau +.gy Guyana +.hk Hong Kong +.hm Heard and McDonald Islands +.hn Honduras +.hr Croatia/Hrvatska +.ht Haiti +.hu Hungary +.id Indonesia +.ie Ireland +.il Israel +.im Isle of Man +.in India +.io British Indian Ocean Territory +.iq Iraq +.ir Iran, Islamic Republic of +.is Iceland +.it Italy +.je Jersey +.jm Jamaica +.jo Jordan +.jp Japan +.ke Kenya +.kg Kyrgyzstan +.kh Cambodia +.ki Kiribati +.km Comoros +.kn Saint Kitts and Nevis +.kp Korea, Democratic People's Republic +.kr Korea, Republic of +.kw Kuwait +.ky Cayman Islands +.kz Kazakhstan +.la Lao People's Democratic Republic +.lb Lebanon +.lc Saint Lucia +.li Liechtenstein +.lk Sri Lanka +.lr Liberia +.ls Lesotho +.lt Lithuania +.lu Luxembourg +.lv Latvia +.ly Libyan Arab Jamahiriya +.ma Morocco +.mc Monaco +.md Moldova, Republic of +.mg Madagascar +.mh Marshall Islands +.mk Macedonia, The Former Yugoslav Republic of +.ml Mali +.mm Myanmar +.mn Mongolia +.mo Macau +.mp Northern Mariana Islands +.mq Martinique +.mr Mauritania +.ms Montserrat +.mt Malta +.mu Mauritius +.mv Maldives +.mw Malawi +.mx Mexico +.my Malaysia +.mz Mozambique +.na Namibia +.nc New Caledonia +.ne Niger +.nf Norfolk Island +.ng Nigeria +.ni Nicaragua +.nl Netherlands +.no Norway +.np Nepal +.nr Nauru +.nu Niue +.nz New Zealand +.om Oman +.pa Panama +.pe Peru +.pf French Polynesia +.pg Papua New Guinea +.ph Philippines +.pk Pakistan +.pl Poland +.pm Saint Pierre and Miquelon +.pn Pitcairn Island +.pr Puerto Rico +.ps Palestinian Territory, Occupied +.pt Portugal +.pw Palau +.py Paraguay +.qa Qatar +.re Reunion Island +.ro Romania +.ru Russian Federation +.rw Rwanda +.sa Saudi Arabia +.sb Solomon Islands +.sc Seychelles +.sd Sudan +.se Sweden +.sg Singapore +.sh Saint Helena +.si Slovenia +.sj Svalbard and Jan Mayen Islands +.sk Slovak Republic +.sl Sierra Leone +.sm San Marino +.sn Senegal +.so Somalia +.sr Suriname +.st Sao Tome and Principe +.sv El Salvador +.sy Syrian Arab Republic +.sz Swaziland +.tc Turks and Caicos Islands +.td Chad +.tf French Southern Territories +.tg Togo +.th Thailand +.tj Tajikistan +.tk Tokelau +.tl Timor-Leste +.tm Turkmenistan +.tn Tunisia +.to Tonga +.tp East Timor +.tr Turkey +.tt Trinidad and Tobago +.tv Tuvalu +.tw Taiwan +.tz Tanzania +.ua Ukraine +.ug Uganda +.uk United Kingdom +.um United States Minor Outlying Islands +.us United States +.uy Uruguay +.uz Uzbekistan +.va Holy See (Vatican City State) +.vc Saint Vincent and the Grenadines +.ve Venezuela +.vg Virgin Islands, British +.vi Virgin Islands, U.S. +.vn Vietnam +.vu Vanuatu +.wf Wallis and Futuna Islands +.ws Western Samoa +.ye Yemen +.yt Mayotte +.yu Yugoslavia +.za South Africa +.zm Zambia +.zw Zimbabwe")) + + + +(defun erbcountry-create-list () + "Creates erbcountry-list from erbcountry-string. " + (let ((strlist (split-string erbcountry-string "[\n]+")) splits dom name) + (dolist (str strlist) + (setq splits (split-string str "[ \t\n]+")) + (setq dom (first splits)) + (setq name (mapconcat 'identity (cdr splits) " ")) + (add-to-list 'erbcountry-list (list dom name))))) + +(erbcountry-create-list) + + + +(defun erbcountry-search (name) + (with-temp-buffer + (insert erbcountry-string) + (goto-char (point-min)) + (if (search-forward name nil t) + (buffer-substring-no-properties (line-beginning-position) + (line-end-position)) + (error "No match. ")))) + + +(defun erbcountry-lookup (ct) + ;;(unless (stringp ct) (setq ct (format "%s" ct))) + (second (assoc ct erbcountry-list))) + +(defalias 'erbcountry 'erbcountry-lookup) + +(provide 'erbcountry) + + + + +;;; erbcountry.el ends here diff --git a/elisp/erbot/erbcspecial.el b/elisp/erbot/erbcspecial.el new file mode 100644 index 0000000..a4d54f7 --- /dev/null +++ b/elisp/erbot/erbcspecial.el @@ -0,0 +1,148 @@ +;;; erbcspecial.el --- Special/dangerous implementation functions. +;; Many fs-functions can simply be defined in terms of other +;; fs-functions (and always should be!, for security.) +;; This file is for the remaining few, that can't be. +;; Thus, CODE IN THIS FILE SHOULD BE CONSTRUCTED VERY CAREFULLY. +1 +;; Time-stamp: <2007-11-23 11:30:12 deego> +;; Copyright (C) 2004 D. Goel +;; Emacs Lisp Archive entry +;; Filename: erbcspecial.el +;; Package: erbcspecial +;; Author: D. Goel <deego@glue.umd.edu> +;; Keywords: +;; Version: +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot +;; For latest version: + + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +;; See also: + +(defconst erbcspecial-version "0.0dev") + +;;========================================== +;;; Requires: +(eval-when-compile (require 'cl)) + + +;;; Code: + +(defun erbn-special-quote-function (fcn) + (cond + ((symbolp fcn) + (erblisp-sandbox-quoted fcn)) + ((and (listp fcn) + (equal (first fcn) 'lambda) + fcn)) + ;; notice the recursion below: + ((listp fcn) (erbn-special-quote-function (fs-eval fcn))) + (t (error "Cannot apply this as a function!")))) + + +;; (defun fs-mapcar-old (sym seq) +;; "only symbols allowed at this time. " +;; (unless (symbolp sym) +;; (error "Function argument to mapcar for this bot can only be a symbol.")) +;; (setq sym (erblisp-sandbox-quoted sym)) +;; ;; everything should already be boxquoted.. cool +;; (mapcar sym seq)) + +(defun fsi-mapcar (fcn ls) + (apply 'mapcar + (erbn-special-quote-function fcn) + ls nil)) + + + + +;; (defun fs-mapc (sym seq) +;; "only symbols allowed at this time. " +;; (unless (symbolp sym) +;; (error "Function argument to mapcar for this bot can only be a symbol.")) +;; (setq sym (erblisp-sandbox-quoted-ensure-symbol sym)) +;; ;; everything should already be boxquoted.. cool +;; (mapc sym seq)) + + + + +(defun fsi-mapc (fcn ls) + (apply 'mapc + (erbn-special-quote-function fcn) + ls nil)) + + + +(defun fsi-mapconcat (fcn ls sep) + (apply 'mapconcat + (erbn-special-quote-function fcn) + ls sep nil)) + + + + + + + +(defun fsi-maplist (fcn ls &rest args) + (require 'cl) + (apply 'maplist + (erbn-special-quote-function fcn) + ls args)) + + + +(defun fsi-mapl (fcn ls &rest args) + (require 'cl) + (apply 'mapl + (erbn-special-quote-function fcn) + ls args)) + +(defun fsi-mapcar* (fcn ls &rest args) + (require 'cl) + (apply 'mapcar* + (erbn-special-quote-function fcn) + ls args)) + + + +(defun fsi-mapcon (fcn ls &rest args) + (require 'cl) + (apply 'mapcon + (erbn-special-quote-function fcn) + ls args)) + + + + + + +;;; Real Code: + + + +(provide 'erbcspecial) +(run-hooks 'erbcspecial-after-load-hook) + + + +;;; erbcspecial.el ends here diff --git a/elisp/erbot/erbdata.el b/elisp/erbot/erbdata.el new file mode 100644 index 0000000..406b86b --- /dev/null +++ b/elisp/erbot/erbdata.el @@ -0,0 +1,66 @@ +;;; erbdata.el --- +;; Time-stamp: <2007-11-23 11:30:12 deego> +;; Copyright (C) 2002 D. Goel +;; Emacs Lisp Archive entry +;; Filename: erbdata.el +;; Package: erbdata +;; Author: D. Goel <deego@gnufans.org> +;; Version: 0.0DEV +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot + + +(defvar erbdata-home-page + "http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot") + + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +;; See also: + +(defvar erbdata-version "0.0dev") + +;;========================================== +;;; Code: + +(defgroup erbdata nil + "The group erbdata" + :group 'applications) +(defcustom erbdata-before-load-hooks nil "" :group 'erbdata) +(defcustom erbdata-after-load-hooks nil "" :group 'erbdata) +(run-hooks 'erbdata-before-load-hooks) + +(defvar erbdata-flames + '( + "%s: Are you smoking crack?" + "%s: Is it larger than a breadbox?" + "What are you smoking, %s?" + "You are confused, but this is your normal state. " + )) + + + + + +(provide 'erbdata) +(run-hooks 'erbdata-after-load-hooks) + + + +;;; erbdata.el ends here diff --git a/elisp/erbot/erbedit.el b/elisp/erbot/erbedit.el new file mode 100644 index 0000000..8831444 --- /dev/null +++ b/elisp/erbot/erbedit.el @@ -0,0 +1,150 @@ +;;; erbedit.el --- quicker operator editing of bots' bbdb +;; Time-stamp: <2007-11-23 11:30:12 deego> +;; Copyright (C) 2003 D. Goel +;; Emacs Lisp Archive entry +;; Filename: erbedit.el +;; Package: erbedit +;; Author: D. Goel <deego@gnufans.org> +;; Keywords: +;; Version: +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot +;; For latest version: + +(defconst erbedit-home-page + "http://gnufans.net/~deego") + + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + + +(defconst erbedit-version "0.0dev") + +;;========================================== +;;; Requires: +(eval-when-compile (require 'cl)) + +;;; Code: + +(defgroup erbedit nil + "The group erbedit." + :group 'applications) +(defcustom erbedit-before-load-hook nil + "Hook to run before loading erbedit." + :group 'erbedit) +(defcustom erbedit-after-load-hook nil + "Hook to run after loading erbedit." + :group 'erbedit) +(run-hooks 'erbedit-before-load-hook) + +(defcustom erbedit-verbosity 0 + "How verbose to be. +Once you are experienced with this lib, 0 is the recommended +value. Values between -90 to +90 are \"sane\". The +rest are for debugging." + :type 'integer + :group 'erbedit) +(defcustom erbedit-interactivity 0 + "How interactive to be. +Once you are experienced with this lib, 0 is the recommended +value. Values between -90 and +90 are \"sane\". The rest are for +debugging." + :type 'integer + :group 'erbedit) +(defcustom erbedit-y-or-n-p-function 'erbedit-y-or-n-p + "Function to use for interactivity-dependent `y-or-n-p'. +Format same as that of `erbedit-y-or-n-p'." + :type 'function + :group 'erbedit) +(defcustom erbedit-n-or-y-p-function 'erbedit-y-or-n-p + "Function to use for interactivity-dependent `n-or-y-p'. +Format same as that of `erbedit-n-or-y-p'." + :type 'function + :group 'erbedit) +(defun erbedit-message (points &rest args) + "Signal message, depending on POINTS anderbedit-verbosity. +ARGS are passed to `message'." + (unless (minusp (+ points erbedit-verbosity)) + (apply #'message args))) +(defun erbedit-y-or-n-p (add prompt) + "Query or assume t, based on `erbedit-interactivity'. +ADD is added to `erbedit-interactivity' to decide whether +to query using PROMPT, or just return t." + (if (minusp (+ add erbedit-interactivity)) + t + (funcall 'y-or-n-p prompt))) +(defun erbedit-n-or-y-p (add prompt) + "Query or assume t, based on `erbedit-interactivity'. +ADD is added to `erbedit-interactivity' to decide whether +to query using PROMPT, or just return t." + (if (minusp (+ add erbedit-interactivity)) + nil + (funcall 'y-or-n-p prompt))) + +;;; Real Code: + + + +(provide 'erbedit) +(run-hooks 'erbedit-after-load-hook) + + +(defun erbedit-replace-string (from to) + "Like fs-replace-string, but acts across the entire bbdb" + "Forget all terms containing occurrence of regexp REG. + +REMINDER: DO NOT FORGET TO exclude terms like fsbot hbot erbot deego +Deepak (author) <and of courser, terms like emacs> in prevent-reg +when using this command. +\\(bot\\|emacs\\|deego\\|goel\\|deepak\\|alex\\|bpt\\|oddmuse\\|iam\\) +.. for example.. +" + (let* + ((lenterms + (fs-search-basic (regexp-quote from) + nil nil 'describe)) + (len (first lenterms)) + (terms (second lenterms))) + (cond + ((= len 0 ) (message "No terms. ")) + (t + (when (y-or-n-p (format "Act on these %S terms? " len)) + (erbedit-replace-string-slowly terms from to)))))) + +(defun erbedit-replace-string-slowly (terms from to) + (let + ((len (length terms)) + (ctr 0) + thisterm + skipp + notes + ) + (while terms + (setq thisterm (car terms) terms (cdr terms)) + (setq ctr (+ ctr 1)) + (message "Acting on term %S of %S: %S" ctr len thisterm) + (sleep-for 0.1) + (fs-replace-string from to thisterm "all") + (message "Acting on term %S of %S: %S ... done" ctr len thisterm) + (sleep-for 0.1) + ))) + + + +;;; erbedit.el ends here diff --git a/elisp/erbot/erbeng.el b/elisp/erbot/erbeng.el new file mode 100644 index 0000000..7aa7aa3 --- /dev/null +++ b/elisp/erbot/erbeng.el @@ -0,0 +1,300 @@ +;;; erbeng.el --- +;; Time-stamp: <2007-11-23 11:30:11 deego> +;; Copyright (C) 2002 D. Goel +;; Emacs Lisp Archive entry +;; Filename: erbeng.el +;; Package: erbeng +;; Author: D. Goel <deego@gnufans.org> +;; Version: 0.0DEV +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot + + +(defvar erbeng-home-page + "http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot") + + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +;; See also: + + +(defvar erbeng-version "0.0dev") + +;;========================================== +;;; Code: + +(require 'cl) +(defgroup erbeng nil + "The group erbeng" + :group 'applications) +(defcustom erbeng-before-load-hooks nil "" :group 'erbeng) +(defcustom erbeng-after-load-hooks nil "" :group 'erbeng) + +(defcustom erbeng-reply-timeout 20 + "Time after which the bot times out...") + +(run-hooks 'erbeng-before-load-hooks) + + + + + +(defvar erbeng-msg nil ) +(defvar erbeng-proc nil) +(defvar erbeng-nick nil) +(defvar erbeng-tgt nil) +(defvar erbeng-localp nil) +(defvar erbeng-userinfo nil) + + +(defvar erbot-show-type-p t + "Whether to show type of non-string objects when replying... + +The old behavior was equivalent to having this as nil.") + + +;;;###autoload +(defun erbeng-main (msg proc nick tgt localp userinfo) + " The main function: Takes a line of message and generates a reply to it. +The result is a string. If the result is 'noreply, that means: Do NOT reply... +The last field localp is here for historical reasons, and shall be +ignored... + +One very important criterion here should be: + +erbot should learn to avoid runaway talks with other bots. For this +reason: + + [a] it should take a break every now and then, say: a 1-minute break +after every 1000 commands. It should probably announce its break. +AND/OR + [b] It should learn to reply only 99 out of 100 times. Moreover, +before it shuts up, it should let any humans know what it is doing. +tgt, nick and sspec will probably mostly remain unused... + +proc == name of the process in the channel +tgt == channel +nick == who from +userninfo looks like (\"deego\" \"user\" \"24-197......\") +sspec looks like: [\"PRIVMSG\" +\"deego!~user@24-197-159-102.charterga.net\" \"#testopn\" \"hi erbot\" \nil +nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil +nil nil\ nil nil nil nil nil nil nil nil] + +" + (let* + ( + (erbeng-nick nick) + (erbeng-msg msg) + (erbeng-proc proc) + (erbeng-tgt tgt) + (erbeng-localp localp) + (erbeng-userinfo userinfo) + (fs-found-query-p nil) + (fs-internal-addressedatlast nil) + (fs-internal-message-sans-bot-name fs-internal-message-sans-bot-name) + (fsi-prestring fsi-prestring) + tmpvar + parsed-msg rep + (fs-msg fs-msg) + (fs-msglist fs-msglist) + (fs-msgsansbot fs-msgsansbot) + (fs-msglistsansbot fs-msglistsansbot) + (fs-lispa fs-lispa) + (fs-lispb fs-lispb) + (fs-lispc fs-lispc) + (fs-lispd fs-lispd) + (fs-lispe fs-lispe) + ) + ;;(concat nick ": " "/leave Test.. one big big test...") + ;;(erbutils-ignore-errors + + ;; this can also modify fs-found-query + (setq parsed-msg + (or (condition-case tmpvar + (fs-parse msg proc nick tgt localp userinfo) + (error + ;;"(error \"Please supply a completed lisp form\")" + ;; Note that this could be bad: + ;; someone may not even be referring to the bot here: + (if + fs-internal-parse-error-p + (format "(error %S )" + (error-message-string tmpvar)) + (format "(fs-english-only %S)" msg)) + + )) + (and (featurep 'erbmsg) + erbot-erbmsg-p + (erbmsg-parse msg proc nick tgt localp userinfo)))) + + ;;(if (and (first parsed-msg) erbot-nick + ;; (string= (first parsed-msg) + ;; erbot-nick)) + ;; parsed-msg will never be null if the msg was addressed to fsbot.. + (if + parsed-msg + (progn + (setq rep + ;;(erbutils-ignore-errors + (with-timeout + (erbeng-reply-timeout + "overall timeout") + (erbutils-ignore-errors + (erbeng-get-reply parsed-msg proc nick tgt ))) + ) + (cond + ((string= "noreply" (format "%s" rep)) 'noreply) + ((and (stringp rep) (not (equal rep ""))) (format "%s%s" + fsi-prestring + rep)) + (t + (cond + (erbot-show-type-p + (format "%s%S ..(%s)" fsi-prestring rep (type-of rep))) + ((equal "" rep) "EMPTY STRING RETURNED") + (t (format "%s%S" fsi-prestring rep)))))) + + 'noreply))) + + + +(defun erbeng-lisp-object-p (msg) + (setq msg (ignore-errors (erbn-read msg))) + (and (listp msg) + (let ((fir (format "%s" (first msg)))) + (or + (string-match "concat" fir) + (string-match "regexp-quote" fir) + ;; want to allow fs-rq to show the regexp without quoting.. + ;;(string-match "fs-rq" fir) + )))) + + + +;(defun erbeng-init-parse (msg) +; (if (equal 0 (string-match "," msg)) +; (setq msg (concat "erbot " +; (substring msg 1 (length msg))))) +; (let ((spl (split-string msg))) +; (if (> (length spl) 0) +; (erbeng-init-frob-split-string spl) +; nil)));;; + +;;; ;(defun erbeng-init-frob-split-string (spl) +;;; ; "spl is the split string ..;;;; + +;;; ;now, we do not need to split wrt commas... in fact, that will be +;;; ;dangerous, and can spoil the meanings of commas inside parse +;;; ;commands...;; + +;;; ;converts all accepted formats to look like this: + + +;;; ; \(\"erbot\" \"foo\" \"bar\"\) + +;;; ;" +;;; ; (let* ((do-again t) +;;; ; (new-spl +;;; ; (cond +;;; ; ;; , foo bar +;;; ;((string= (first spl) ",") +;;; (cons erbot-nick (cdr spl))) +;;; ((equal +;;; (string-match "," (first spl)) 0) +;;; (cons erbot-nick +;;; (append (split-string (first spl) ",") +;;; (cdr spl)))) +;;; ((equal +;;; ;; erbot: +;;; (string-match (concat erbot-nick ":") (first spl)) 0) +;;; (append (split-string (first spl) ":") +;;; (cdr spl))) +;;; ((equal +;;; ;; fdbot, +;;; (string-match (concat erbot-nick ",") (first spl)) 0) +;;; (append (split-string (first spl) ",") +;;; (cdr spl))) +;;; (t (progn (setq do-again nil) spl))))) +;;; (if do-again +;;; (erbeng-init-frob-split-string new-spl) +;;; ;; removed the extra "" etc. and all , ; erc. etc. +;;; (split-string +;;; (mapconcat 'identity +;;; new-spl " ") +;;; "[ \f\t\n\r\v,;]+")))) + + + + +(defun erbeng-get-reply (msg &optional proc nick tgt &rest foo) + " ;; now assumes that the msg is (a string) in lisp format... and this just + ;; evals it.." + (eval (erbn-read msg))) +; (let* ( +; (lispmsg +; (erbeng-read (erbutils-stringify msg)))) +; (if (and lispmsg (listp lispmsg)) +; (erblisp-process-msg proc nick tgt +; lispmsg) +; (let ((englispmsg (fs-parse-english msg proc nick))) +; (erblisp-process-msg proc nick tgt englispmsg))))) + + + +(defun erbeng-read (msg) + (ignore-errors (erbn-read msg))) + + + + + + + + + + +;; proposed register syntax.. +(defun erbeng-register-syntax (fsbot-command priority check &optional + remap) + +"If CHECK is a function, then it is passed the user input as a +string... If it claims a match, it should return (t arglist). +Arglist is a list of arguments to be passed to the FSBOT-COMMAND. + +If CHECK is a regexp, it is matched against the user input string. If +it is a match, all the submatches 1....n (NOT 0) are passed to the +function as arguments in that order, except that you can remap using +the optional REMAP list. That list is a list of numbers, like, say (0 +1 2 4).<-- this tells us that the arguments to be passed to the +fsbot-command are the regexp-matches 0,1,2 4 in that order. If REMAP +is not supplied, you can see that the default value is more-or-less +equivalent to (1 2 3 4....) + +" +nil) + + +(provide 'erbeng) +(run-hooks 'erbeng-after-load-hooks) + + + +;;; erbeng.el ends here diff --git a/elisp/erbot/erbforget.el b/elisp/erbot/erbforget.el new file mode 100644 index 0000000..99e02e6 --- /dev/null +++ b/elisp/erbot/erbforget.el @@ -0,0 +1,138 @@ +;;; erbforget.el --- Help make the bots forget some TERMS. +;; Time-stamp: <2007-11-23 11:30:10 deego> +;; Copyright (C) 2003 D. Goel +;; Emacs Lisp Archive entry +;; Filename: erbforget.el +;; Package: erbforget +;; Author: D. Goel <deego@gnufans.org> +;; Keywords: +;; Version: +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot + + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +;;========================================== +;;; Requires: +(eval-when-compile (require 'cl)) + +;;; Code: + +(defgroup erbforget nil + "The group erbforget." + :group 'applications) +(defcustom erbforget-before-load-hooks nil + "Hooks to run before loading erbforget." + :group 'erbforget) +(defcustom erbforget-after-load-hooks nil + "Hooks to run after loading erbforget." + :group 'erbforget) +(run-hooks 'erbforget-before-load-hooks) + +;;; Real Code: + + +(defun erbforget-sw (reg &optional prevent-reg matchingonly) + "RUN THIS AS MYBOT WHEN SU-ED TO THE BOT. + +Forget all terms containing occurrence of regexp REG. + +REMINDER: DO NOT FORGET TO exclude terms like fsbot hbot erbot deego +Deepak (author) <and of course, terms like emacs> in prevent-reg +when using this command. +\\(bot\\|emacs\\|deego\\|goel\\|deepak\\|alex\\|bpt\\|oddmuse\\|iam\\) +.. for example.. +Return len, which may (or may not) correspond to the number of items +removed. +" + (interactive "sRegex to forget: ") + (let* + ((lenterms + (fs-search-basic reg nil nil 'describe)) + (len (first lenterms)) + (terms (second lenterms))) + (cond + ((= len 0 ) (message "No such terms. ")) + (t + (when (erbforget-y-or-n-p 40 (format "Forget %S terms? " len)) + (erbforget-slowly terms prevent-reg matchingonly reg)))) + len)) + + +(defun erbforget-slowly (terms &optional prevent-reg matchingonly reg) + "When matchingonly is t, we forget only the particular entry in the +NOTES that matches the regexp REG, if any..." + (let + ((len (length terms)) + (ctr 0) + thisterm + skipp + notes + ) + (while terms + (setq thisterm (car terms) terms (cdr terms)) + (setq ctr (+ ctr 1)) + (setq notes (fs-notes thisterm)) + (setq skipp + (and prevent-reg + (string-match prevent-reg + (mapconcat 'identity notes " ")))) + (cond + + (skipp + (message "NOT FORGETTING term %S of %S: %S" ctr len thisterm) + (sleep-for 1) + ) + (matchingonly + (let ((num -1) (donep nil)) + (while (not donep) + (incf num 1) + (cond + ((>= num (length notes)) + (setq donep t)) + ((string-match reg (nth num notes)) + (setq donep t) + (message "Forgetting term %S of %S: %S" ctr len thisterm) + (sleep-for 0.1) + (fs-forget thisterm num)) + (t nil))))) + + (t + (message "Forgetting term %S of %S: %S" ctr len thisterm) + (sleep-for 0.1) + (fs-forget thisterm "all") + (message "Forgetting term %S of %S: %S.. done" ctr len thisterm) + (sleep-for 0.1) + ) + + + )))) + + + + + + +(provide 'erbforget) +(run-hooks 'erbforget-after-load-hooks) + + + +;;; erbforget.el ends here diff --git a/elisp/erbot/erbim.el b/elisp/erbot/erbim.el new file mode 100644 index 0000000..f43a386 --- /dev/null +++ b/elisp/erbot/erbim.el @@ -0,0 +1,216 @@ +;;; erbim.el --- input method searching +;; Time-stamp: <2006-08-22 01:16:17 fledermaus> +;; Copyright (C) 2006 V. Dasmohapatra +;; Emacs Lisp Archive entry +;; Filename: erbim.el +;; Package: erbim +;; Author: V. Dasmohapatra <vivek@etla.org> +;; Keywords: +;; Version: +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot +;; For latest version: + +(require 'quail) +(require 'iso-transl) + +(defvar erbim-keymaps-map nil + "Storage for the inverted keymaps for the input methods we have searched.") + +(defun erbim-enc (thing) + "Standard encoding for all strings (many chars don't work in an emacs +running screen, so chars and unencoded strings may not be safe or work)." + (encode-coding-string thing 'utf-8)) + +(defun erbim-c2s (thing) + "map a character to the appropriate string. This is not a straightforward +operation using char-to-string (for some reason)." + (if (> 256 thing) (single-key-description thing) (char-to-string thing))) + +(defun erbim-map (map) + "Traverse the input method's MAP, invert it, and return that." + (let ((char-map nil)) + (mapc (lambda (M) (erbim-map-internal M "")) (cdr map)) char-map)) + +(defun erbim-interpret-target (target) + "Examine the TARGET of a given input method map entry and turn it +into a list of (unencoded) strings.\n +Destinations can be symbols (keyboard macros) vectors of strings or +vectors of characters, or a cons of the form (LIST . TARGET)." + ;;(message "target %S" target) + (if (vectorp target) + (mapcar (lambda (T) (if (integerp T) (erbim-c2s T) T)) target) + (if (and (listp target) (listp (car target))) + (progn (message "weird target: %S" target) + (erbim-interpret-target (cdr target))) + (if (symbolp target) + (and (fboundp target) + (and (vectorp (symbol-function target)) + (erbim-interpret-target (symbol-function target)) )) + (list (if (integerp target) (string target) target)) )) )) + +(defun erbim-map-internal (map &optional so-far) + "Does the actual work of `erbim-map'." + (let ((iseq-str + (format (if (symbolp (car map)) "%s %S " "%s%c") (or so-far "") + (car map))) + (tgt nil) + (tail nil)) + ;;(message "%S %S" map so-far) + (setq tgt (cdr map)) + (if (setq tgt (or (car-safe tgt) + (and (vectorp tgt) tgt) + (and (symbolp tgt) tgt))) + (progn + ;;(message "tgt: %S" tgt) + (setq char-map + (append char-map + (mapcar + (lambda (T) (cons (erbim-enc T) iseq-str)) + (erbim-interpret-target tgt)) )) + (when (and (listp (cdr map)) (setq tail (cddr map))) + (if (listp (cdar tail)) + (erbim-map-internal (car tail) iseq-str) + ;;(message "path B: %S" tail) + (mapcar (lambda (M) (erbim-map-internal M iseq-str)) tail)) )) + (when (listp (cdr map)) + (mapcar + (lambda (M) (erbim-map-internal M iseq-str)) (cddr map))) ) )) + +(defun erbim-package-list () + "Return the list of input methods that erbim can understand. +iso-transl is not exactly an input method, but it is a special case." + (cons "iso-transl" + (mapcar (lambda (I) (if (eq (caddr I) 'quail-use-package) (car I))) + input-method-alist) )) + +(defun erbim-keymap-map (im) + "Return the inside-out keymap for input method IM (IM is a string)." + (or (cdr (assoc im erbim-keymaps-map)) + (let ( (map (erbim-map + (nth 2 (assoc im quail-package-alist)))) ) + (setq erbim-keymaps-map (cons (cons im map) erbim-keymaps-map)) map) )) + +(defun where-is-char (c &optional im-list) + "Given a string C (usually, but not always, one character (but NOT +necessarily one byte)) in length, search the input methods in either IM-LIST +or `erbim-package-list' and return a help string describing the key sequences +\(per input method) that can be used to enter C." + ;; assume we got a string: char functions are broken in fsbot becuase of + ;; some screen/emacs/terminal black magic (which I do not understand) + ;; so we cannot use (aref string 0) or string-to-char reliably. + (let ((char (erbim-enc c)) + (res nil) + (qsec nil)) + (mapc (lambda (Q) + ;; exclude chinese-* methods (too big) and misc problematic ones: + (when (and Q + (not (string-match "^chinese-" Q)) + (not (member Q '("tibetan-wylie" ;; too big? + ;; "greek-ibycus4" ;; ok actually + )) )) + ;; load the input method if it's not iso-transl (special case) + ;; and we haven't already done so: + (or (equal Q "iso-transl") + (with-temp-buffer + (or (assoc Q quail-package-alist) + (activate-input-method Q)) )) + (message "checking %s" Q) + ;; check to see if we have a quail package (iso-transl is + ;; not a quail package, don't check for it here): + (when (or (equal Q "iso-transl") (assoc Q quail-package-alist)) + ;;(message "%s keymap - %d" Q (length (erbim-keymap-map Q))) + ;; extract the inverse keymap if there is one, and pull + ;; out the first entry for the char we are looking for: + (when (setq qsec (assoc char (erbim-keymap-map Q))) + ;;(message "found sequence %s" qsec) + (setq res (cons (cons Q (cdr qsec)) res)) )) )) + (or im-list (erbim-package-list))) + ;; feed the results to the user (if there are lots of input methods, + ;; just list the input methods instead): + (if (> (length res) 10) + (format "%s is in the following input methods:\n%s" + c (mapconcat 'car res " ")) + (mapconcat + (lambda (R) + (if (equal (car R) "iso-transl") + (mapconcat 'identity + (cons "C-x 8" (split-string (cdr R) "")) " ") + (format "%s: %s" (car R) (cdr R)) )) res "\n")) )) + +(defun fsi-where-is-char (&optional key &rest im-list) + (let ((imlist nil) + (key (if key (if (symbolp key) (symbol-name key) key) nil))) + (if key (where-is-char key (mapcar 'symbol-name im-list)) + "where-is-char <CHAR-OR-SEQUENCE> [ INPUT-METHOD INPUT-METHOD... ]") )) + +;; load iso-transl's inverted keymap +(add-to-list 'erbim-keymaps-map + (cons "iso-transl" (erbim-map iso-transl-ctl-x-8-map))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Unicode information functions: +(defvar erbim-unidata-file "/usr/share/perl/5.8.4/unicore/UnicodeData.txt") + +(defun erbim-name-by-character (thing) + (let ((char (if (stringp thing) (string-to-char thing) thing)) + (unicode nil)) + (setq unicode + (when (or (< char 256) + (memq 'coding-category-utf-8 + (mapcar 'coding-system-category + (find-coding-systems-string thing)))) + (encode-char char 'ucs)) ) + (erbim-name-by-codepoint unicode)) ) + +(defun erbim-name-by-codepoint (codepoint) + (let ((cpstring (format "%04X" codepoint)) + (unidata (find-file-noselect erbim-unidata-file))) + (with-current-buffer unidata + (goto-char (point-min)) + (if (re-search-forward (concat "^" cpstring ";\\([^;]*\\);") nil t) + (format "#x%s: %s" cpstring (match-string 1)) + (format "Unknown character #x%s" cpstring) )) )) + +(defun erbim-search-by-description (pat) + (let ( (unidata (find-file-noselect erbim-unidata-file)) + (pattern nil) + (case-fold-search t) + (count 0) + (limit 10) + (found nil) + (char nil) + (cp nil) + (matches nil)) + (setq pattern (replace-regexp-in-string "^\\^\\|\\$$" "" pat) + pattern + (concat "^\\([0-9A-F]+\\);\\(" (if (eq (aref pat 0) ?^) "" "[^;]*") + pattern + (if (eq (aref pat (1- (length pat))) ?$) "" "[^;]*") "\\);")) + (with-current-buffer unidata + (goto-char (point-min)) + (while (re-search-forward pattern nil t) + (when (< (setq count (1+ count)) limit) + (setq cp (string-to-int (match-string 1) #x10) + char (or (decode-char 'ucs cp) ?�) + found (format "#x%04x (%c): %s" cp char (match-string 2)) + matches (cons found matches)) )) ) + (if (< count limit) + (mapconcat 'identity (nreverse matches) "\n") + (format "Too many matches (%d) for %S" count pat)) )) + +(defun fs-unicode-find (&optional pattern) + (if pattern (erbim-search-by-description pattern) + "Usage: unicode-find <REGEX TO MATCH UNICODE DATA FILE DESCRIPTION>")) + +(defun fs-unicode-describe (&optional thing) + (cond ((not thing) "Usage: unicode-describe <CODEPOINT-INTEGER | CHARACTER>") + ((integerp thing) (erbim-name-by-codepoint thing)) + ((symbolp thing) (erbim-name-by-character (symbol-name thing))) + (thing (erbim-name-by-character thing)) )) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; trigger the preprocessing of the rest of the input methods: +(where-is-char "x") + +(provide 'erbim) + diff --git a/elisp/erbot/erbjavadoc.el b/elisp/erbot/erbjavadoc.el new file mode 100644 index 0000000..eeb4ead --- /dev/null +++ b/elisp/erbot/erbjavadoc.el @@ -0,0 +1,169 @@ +;;; erbjavadoc.el --- Learn terms from a url. +;; Time-stamp: +;; Copyright (C) 2004 Pete Kazmier +;; Emacs Lisp Archive entry +;; Filename: erbjavadoc.el +;; Package: erbjavadoc +;; Author: Pete Kazmier <pete-erbot-dev@kazmier.com> +;; Keywords: +;; Version: +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot + +(defconst erbtrain-home-page + "http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot") + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +;; See also: + +;;========================================== +;;; Requires: +(require 'cl) +(require 'erburl) + +;;; Code: + +(defgroup erbjavadoc nil + "The group erbjavadoc." + :group 'applications) + +(defcustom erbjavadoc-before-load-hooks nil + "Hooks to run before loading erbjavadoc." + :group 'erbjavadoc) + +(defcustom erbjavadoc-after-load-hooks nil + "Hooks to run after loading erbjavadoc." + :group 'erbjavadoc) + +(run-hooks 'erbjavadoc-before-load-hooks) + +;;; Real Code: + +;; I need to persist this var somehow, are there any facilities +;; in erbot to do this? +(defvar erbjavadoc-scraped-urls '() + "A list of javadoc urls that have been learned already. This +is used to prevent users from learning a url more than once.") + +;; In the meantime until a better way to persist immutable vars +;; is in place, I'll just write out the value to a file. +(defvar erbjavadoc-data-file "~/public_html/data/state-erbjavadoc.el") + +(defun erbjavadoc-load-data () + (when (file-exists-p erbjavadoc-data-file) + (ignore-errors (load erbjavadoc-data-file)))) + +(defun erbjavadoc-save-data () + (erbn-write-sexps-to-file erbjavadoc-data-file + (list `(setq erbjavadoc-scraped-urls + ',erbjavadoc-scraped-urls)))) + +(erbjavadoc-load-data) + +(defvar erbjavadoc-pages '("allclasses-frame.html" "overview-frame.html") + "The names of the index pages generated by javadoc. These names +will be appended to a base url and then these pages will be scraped +for terms.") + +(defun erbjavadoc-base-url (url) + "Returns the base url for a given URL. Strips off any trailing +filename component and/or trailing slash. Converts the following: + + http://example.com/test/ -> http://example.com/test + http://example.com/test/name.html -> http://example.com/test +" + (let ((p (string-match "/\\([^/]+\\.[^/]+\\)?$" url))) + (if p + (substring url 0 p) + url))) + +(defun fsi-learn-javadocs (url) + "Add the Java package and class names as terms in the bot's bbdb +with links to the appropriate pages. A single URL is passed as the +only argument and can only be learned once until its been forgotten. +It should be noted that this command can only be executed via a user +in IRC because in relies on various vars that are in scope when +erbot.el invokes this function." + (unless (stringp url) (setq url (format "%s" url))) + (let ((base (erbjavadoc-base-url url))) + (if (member base erbjavadoc-scraped-urls) + "That set of javadocs has already been learned." + (dolist (page erbjavadoc-pages) + (let ((pageurl (concat base "/" page))) + ;; See the docsting for erburl-scrape-terms for more + ;; information on its arguments. Lack of closures + ;; makes this more complicated than need be. + (erburl-scrape-terms pageurl + ;; Entry parser callback, we use the + ;; standard parser and supply it with + ;; the appropriate base url to use and + ;; limit the terms learned to terms + ;; that don't contain spaces. + (lambda (base &rest not-used) + (erburl-href-parser base t)) + ;; Progress callback, the default is + ;; to use 'message, but we want the + ;; progress to be sent back to the + ;; user that invoked the command, so + ;; we use erbot-reply. + (lambda (msg not-used proc nick tgt) + (save-excursion + (set-buffer (process-buffer proc)) + (erbot-reply msg proc nick tgt "" nil))) + ;; These arguments are passed as + ;; extra parameters to our callback + ;; functions. We need these so that + ;; we can invoke erbot-reply. + (list base proc erbn-nick tgt)))) + (push base erbjavadoc-scraped-urls) + (erbjavadoc-save-data) + (format "I'm downloading the javadocs now ...")))) + +;; This function should not be made available to users until I can +;; figure out how to make the underlying erburl-forget-terms an +;; asychronous operation. Currently, if a user invokes this and there +;; are a large number of entries to remove, the operation times out +;; from the top-level timer in erbot (I think) +;; +;; (defun fsi-forget-javadocs (url) +;; "Remove all terms and entries for the URL specified. This will +;; remove the appropriate entries from the bbdb. If an entry has more +;; than one definition, only the relevant entry is removed." +;; (unless (stringp url) (setq url (format "%s" url))) +;; (let ((base (erbjavadoc-base-url url))) +;; (if (not (member base erbjavadoc-scraped-urls)) +;; "This set of javadocs has not been learned." +;; (let ((count (erburl-forget-terms base))) +;; (setq erbjavadoc-scraped-urls (remove base erbjavadoc-scraped-urls)) +;; (erbjavadoc-save-data) +;; (format "I have removed %S entries for %S" count base))))) + +(defun fsi-learned-javadocs () + "Return a list of learned javadocs." + (cond ((= 0 (length erbjavadoc-scraped-urls)) + "I have not learned any javadocs.") + (t + (format "I know about the following javadocs: %s" + (mapconcat 'identity erbjavadoc-scraped-urls ", "))))) + +(provide 'erbjavadoc) +(run-hooks 'erbjavadoc-after-load-hooks) + +;;; erbjavadoc.el ends here diff --git a/elisp/erbot/erbkarma.el b/elisp/erbot/erbkarma.el new file mode 100644 index 0000000..3b27103 --- /dev/null +++ b/elisp/erbot/erbkarma.el @@ -0,0 +1,163 @@ +;;; erbkarma.el --- karma is not currently functional, we think.. +;; Time-stamp: <2007-11-23 11:30:09 deego> +;; Copyright (C) 2002 D. Goel +;; Emacs Lisp Archive entry +;; Filename: erbkarma.el +;; Package: erbkarma +;; Authors: D. Goel <deego@gnufans.org> +;; Keywords: +;; Version: +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot + + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; 2003-01-29 T13:10:42-0500 (Wednesday) D. Goel +;; removed +;; Dheeraj Buduru <dbuduru@yahoo.com> +;; from authors' list at his request. :( + + +;;; 2004-01-22 T07:18:36-0500 (Thursday) D. Goel +;; <kensanata> deego: fsbot should get the old silly karma system back. fsbot +;; forget all karma points whenever he disconnects. the only +;; important thing is that we can say b0ef++ and fsbot responds with +;; "Noted, kensanata. One (brownie|karma|wiki|rms|lispy)-point for +;; b0ef!" + +;;========================================== +;;; Requires: +(eval-when-compile (require 'cl)) +(require 'pp) +(require 'thingatpt) +;;; Code: + +(defgroup erbkarma nil + "The group erbkarma." + :group 'applications) +(defcustom erbkarma-before-load-hooks nil + "Hooks to run before loading erbkarma." + :group 'erbkarma) +(defcustom erbkarma-after-load-hooks nil + "Hooks to run after loading erbkarma." + :group 'erbkarma) +(run-hooks 'erbkarma-before-load-hooks) + +;;; Real Code: + + +(defcustom erbkarma-file "~/public_html/karma/karma" + "") + +(defcustom erbkarma-min -1000 "") +(defcustom erbkarma-max +1000 "") + +(defvar erbkarma nil + "stores all karma" + ) + + +(defun erbkarma-read () + (save-window-excursion + (unless erbkarma + (setq erbkarma + (ignore-errors + (find-file erbkarma-file) + (goto-char (point-min)) + (sexp-at-point)))))) + +(defun erbkarma (&optional entity) + (cond + ((not entity) (fs-karma-best)) + (t + (unless (stringp entity) + (setq entity (format "%s" entity))) + (erbkarma-read) + (second + (assoc entity erbkarma))))) + +(defun erbkarma-save () + (save-window-excursion + (find-file erbkarma-file) + (delete-region (point-min) (point-max)) + (insert (pp-to-string erbkarma)) + (write-file erbkarma-file) + (kill-buffer (current-buffer)))) + + + + +(defun erbkarma-increase (entity &optional points) + (format "%s" entity) + (erbkarma-tgt-check) + (unless points (setq points 1)) + (erbkarma-read) + (let* ((eass (assoc entity erbkarma)) + (val (if eass (second eass) 0)) + (newval (+ val points)) + (removed (remove eass erbkarma))) + (setq erbkarma + (if (= newval 0) + removed + (cons + (list entity newval) + removed))) + (erbkarma-save) + (format "%s" newval))) + +(defun erbkarma-decrease (entity &optional points) + (erbkarma-tgt-check) + (unless points (setq points 1)) + (erbkarma-increase entity (- points))) + +(defun erbkarma-sort () + (setq erbkarma + (sort + erbkarma + '(lambda (a b) + (> (second a) (second b))))) + (erbkarma-save)) + +(defun erbkarma-best (&optional n bottomp) + (unless n (setq n 5)) + (erbkarma-sort) + (let ((result (if bottomp + (reverse erbkarma) + erbkarma))) + (if (> n (length result)) + result + (subseq result 0 n)))) +(defalias 'fs-best-karma 'fs-karma-best) + +(defcustom erbkarma-tgt-check-string + "^\\(#emacs\\|#gnu\\|#fsf\\|#hurd-bunny\\|deego\\|#wiki\\)$" + "" :group 'erbkarma + ) + +(defun erbkarma-tgt-check () + (unless (string-match erbkarma-tgt-check-string fs-tgt) + (error + "Do it publicly. "))) + +(provide 'erbkarma) +(run-hooks 'erbkarma-after-load-hooks) + + + +;;; erbkarma.el ends here diff --git a/elisp/erbot/erblisp.el b/elisp/erbot/erblisp.el new file mode 100644 index 0000000..6530b94 --- /dev/null +++ b/elisp/erbot/erblisp.el @@ -0,0 +1,276 @@ +;;; erblisp.el --- +;; Time-stamp: <2007-11-23 11:30:08 deego> +;; Copyright (C) 2002 D. Goel +;; Emacs Lisp Archive entry +;; Filename: erblisp.el +;; Package: erblisp +;; Author: D. Goel <deego@gnufans.org> +;; Version: 0.0DEV +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot + + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +;; See also: + + +(defvar erblisp-version "0.0dev") + +;;========================================== +;;; Code: + +(defgroup erblisp nil + "The group erblisp" + :group 'applications) +(defcustom erblisp-before-load-hooks nil "" :group 'erblisp) +(defcustom erblisp-after-load-hooks nil "" :group 'erblisp) +(run-hooks 'erblisp-before-load-hooks) + + +(defun erblisp-process-msg (msg &optional proc nick tgt) + "MSG is either a string or a tree.. If it is a tree, it looks +something like + '(foo bar (bar foo)) + +This command sandboxes the message and then processes it.." + + (if (stringp msg) + (setq msg (erbn-read msg))) + (format "%s" (eval (erblisp-sandbox-fuzzy msg)))) + +(defun erblisp-sandbox-quoted-maybe (expr) + "sandboxes the whole expression even if it starts with a quote." + (cond + ((and (listp expr) + (equal (first expr) 'quote)) + (cons 'quote + (mapcar 'erblisp-sandbox (cdr expr)))) + (t (erblisp-sandbox expr)))) + + +(defun erblisp-sandbox-quoted (expr) + "Assumes that the expression will result in a quoted thingy and +tries to make sure that we sandbox that whole quoted thing.. " + (cond + ((and (listp expr) + (equal (first expr) 'quote)) + (cons 'quote + (mapcar 'erblisp-sandbox (cdr expr)))) + ((listp expr) + (list 'erblisp-sandbox-quoted (erblisp-sandbox expr))) + ;; just an atom + (t (erblisp-sandbox expr)))) + + +(defvar erblisp-allowed-words + '(nil t + ;; Also consider: + ;; &rest + ;; &optional + + ) + "You should add &rest and &optional to this list. +We WON'T do this by default since this could lead to exploits if you +*happen* to have bound these keywords to weird stuff like +\(setq &rest (shell-command \"rm -rf /\")) in your .emacs." +) + +(defvar erblisp-max-list-length 2000 + "If non-numeric, we will skip this check." + ) + +(defun erblisp-safe-length-args-p (list so-far len) + (let ((cur list) + stack) + (while (and cur + (<= so-far len)) + (if (consp (car cur)) + (progn (setq cur (car cur)) + (when (consp (cdr cur)) + (push (cdr cur) stack))) + (setq cur (cdr cur))) + (unless cur + (setq cur (pop stack))) + (setq so-far (1+ so-far))) + (if (<= so-far len) + t + nil))) + +(defmacro erblisp-check-args (&rest args) + "All we do in this macro we remove some bindings for things like +&rest, etc, things that do not have values but got passed to us -- +this occurs when a user attempts to use &rest in his function +definitions -- see `erblisp-allowed-words'. + +All the arguments to this macro should have been in their evalled form +and hence constants already, so we do not bother protecting against +multiple evaluations here -- evaluating a constant causes no harm. +All we do in this macro we remove some bindings for things like &rest, +etc, things that are not defined, but passed on here in any case." + `(erblisp-check-args-nascent + ,@(remove-if + #'(lambda (arg) (and + (symbolp arg) + (not (boundp arg)))) + args))) + + + +(defun erblisp-check-args-nascent (&rest args) + (if (or + (not (numberp erblisp-max-list-length)) + (erblisp-safe-length-args-p args 0 erblisp-max-list-length)) + t + (error "encountered overlong expression, ignoring") nil)) + + + + +(defun erblisp-sandbox (expr) + "" + (cond + ;; first condition + ((null expr) nil) + ;; second condition + ((listp expr) + (when (erblisp-check-args expr) + (let ((fir (first expr))) + (cond + ((listp fir) + (cons (erblisp-sandbox fir) + (mapcar 'erblisp-sandbox (cdr expr)))) + ((equal (format "%S" fir) "quote") + ;; if quoted, it is fine... + expr) + (t (cons + (if (or (equal 0 (string-match "fs-" (format "%S" fir))) + (member fir erblisp-allowed-words)) + fir + (intern (concat "fs-" (format "%S" fir)))) + (mapcar 'erblisp-sandbox (cdr expr)))))))) + + ;; final condition.. --> when the expr is an atom.. It should be a + ;; a constant.. or an allowed atom.. allowed == prefixed with fs- + (t (cond + ((and (symbolp expr) + (equal 0 (string-match "fs-" (format "%s" expr)))) + expr) + ((equal expr t) expr) + ((member expr erblisp-allowed-words) expr) + ((symbolp expr) + ;;(boundp (intern (concat "fs-" (format "%S" expr))))) + (intern (concat "fs-" (format "%s" expr)))) + ;; other symbol + ;;((symbolp expr) (list 'quote expr)) + ;; a number or string now.. + ;; this actually happens when they feed byte-compiled code to + ;; the bot, like: + ;;, (funcall #[nil "\300\207" [1] 1]) + ((not (or (symbolp expr) (numberp expr) (stringp expr))) + (error "%s %s" "Should not reach here. Quantum Tunnelling! " + "What are you trying to feed me? Byte-compiled code? Vectors?" )) + (t expr))) + )) + +(defun erblisp-sandbox-fuzzy (expr) + "Sandboxes a message.. Ensures that the functions are all fs- +and the arguments are NOT variable-names... This one sandboxes +preferably by quoting unless fs-symbol is bound.." + (cond + + ;; first condition + ((null expr) nil) + + ;; second condition + ((listp expr) + (let ((fir (first expr))) + (cond + ((listp fir) + (cons (erblisp-sandbox-fuzzy fir)) + (mapcar 'erblisp-sandbox-fuzzy (cdr expr))) + ((equal (format "%S" fir) "quote") + ;; if quoted, it is fine... + expr) + (t (cons + (if (equal 0 (string-match "fs-" (format "%S" fir))) + fir + (intern (concat "fs-" (format "%S" fir)))) + (mapcar 'erblisp-sandbox-fuzzy (cdr expr))))))) + + + ;; final condition.. --> when the expr is an atom.. It should be a + ;; a constant.. or an allowed atom.. allowed == prefixed with fs- + (t (cond + ((and (symbolp expr) + (equal 0 (string-match "fs-" (format "%s" expr)))) + expr) + ((and (symbolp expr) + (or + (boundp (intern (concat "fs-" (format "%S" expr)))) + (fboundp (intern (concat "fs-" (format "%S" expr)))) + )) + (intern (concat "fs-" (format "%s" expr)))) + ;; other symbol + ((symbolp expr) (list 'quote expr)) + ;; a number or string now.. + + ((not (or (symbolp expr) (numberp expr) (stringp expr))) + (error "Should not reach here. Fuzzy tunnels!")) + (t expr))) + )) + + + + +(defun erblisp-sandbox-full(expr &optional midstream) + " +This will ensure that anything rigt after parens is sandboxed by a +fs- prefix. And anything else is either a symbol , or a string, +but not a variable... viz: quoted ...else converted into one. + +midstream is in internal variable..." + (cond + ((null expr) nil) + ((listp expr) + (let* ((fir (first expr))) + (if (eql fir 'quote) + expr + (cons (erblisp-sandbox-full fir) + (mapcar '(lambda (arg) + (erblisp-sandbox-full arg t)) + (cdr expr)))))) + ;; now we know that expr is a non-nil atom... + (midstream + (if (stringp expr) expr + (list 'quote expr))) + + + + ;; midstream is untrue... expr is thus an atom at the beginning.. + (t + (if (equal 0 (string-match "fs-" (format "%s" expr))) + expr (intern (concat "fs-" (format "%s" expr))))))) + +(provide 'erblisp) +(run-hooks 'erblisp-after-load-hooks) + + + +;;; erblisp.el ends here diff --git a/elisp/erbot/erblog.el b/elisp/erbot/erblog.el new file mode 100644 index 0000000..0e46803 --- /dev/null +++ b/elisp/erbot/erblog.el @@ -0,0 +1,78 @@ +;;; erblog.el --- +;; Time-stamp: <2007-11-23 11:30:08 deego> +;; Copyright (C) 2002 D. Goel +;; Emacs Lisp Archive entry +;; Filename: erblog.el +;; Package: erblog +;; Author: D. Goel <deego@gnufans.org> +;; Version: 0.0DEV +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot + + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +;; See also: + +(defvar erblog-version "0.0dev") + +;;========================================== +;;; Code: + +(defgroup erblog nil + "The group erblog" + :group 'applications) +(defcustom erblog-before-load-hooks nil "" :group 'erblog) +(defcustom erblog-after-load-hooks nil "" :group 'erblog) +(run-hooks 'erblog-before-load-hooks) + + +(defvar erblog-active-targets nil + "This stores the list of targets that have had some activity... + +The idea is that the operator sets this to nil (see commands +below).. goes away, comes back and examined this variables to find +out which channels have had activity... +") + +(defun erblog-log-target (target &rest stuff) + (unless (member (format "%s" target) + erblog-active-targets) + (progn + (add-to-list 'erblog-active-targets + (format "%s" target)) + (erblog-show-targets)))) + +;; operator bind to C-c s +(defun erblog-show-targets () + (interactive) + (message "%s" erblog-active-targets)) + +;; bind to C-c r +(defun erblog-reset-targets () + (interactive) + (message "Nulling.. was %s" erblog-active-targets) + (setq erblog-active-targets nil)) + +(provide 'erblog) +(run-hooks 'erblog-after-load-hooks) + + + +;;; erblog.el ends here diff --git a/elisp/erbot/erbmerge.el b/elisp/erbot/erbmerge.el new file mode 100644 index 0000000..2d1e5db --- /dev/null +++ b/elisp/erbot/erbmerge.el @@ -0,0 +1,48 @@ +;;; erbmerge.el --- merge 2 bbdb's -- NOT YET IMPLEMENTED +;; Time-stamp: <2007-11-23 11:30:07 deego> +;; Copyright (C) 2004 D. Goel +;; Emacs Lisp Archive entry +;; Filename: erbmerge.el +;; Package: erbmerge +;; Author: D. Goel <deego@glue.umd.edu> +;; Keywords: +;; Version: +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot +;; For latest version: + + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +;; See also: + +;;; Requires: +(eval-when-compile (require 'cl)) + +;;; Real Code: +;; Use functions like fs-notes... See the code of erbforget-slowly.. +;; NOT YET IMPLEMENTED. + + +(provide 'erbmerge) +(run-hooks 'erbmerge-after-load-hook) + + + +;;; erbmerge.el ends here diff --git a/elisp/erbot/erbmsg.el b/elisp/erbot/erbmsg.el new file mode 100644 index 0000000..4a0f748 --- /dev/null +++ b/elisp/erbot/erbmsg.el @@ -0,0 +1,583 @@ +;;; erbmsg.el --- memoserv-esque functions for Erbot +;; $Id: erbmsg.el,v 1.26 2007/11/23 16:31:59 deego Exp $ +;; Copyright (C) 2004 Sebastian Freundt +;; Emacs Lisp Archive entry +;; Filename: erbmsg.el +;; Package: erbmsg +;; Authors: Sebastian Freundt <freundt@math.tu-berlin.de> +;; Keywords: memo, message, +;; Version: still conceptional +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErbMsg +;; For latest version: + +(defconst erbot-home-page + "http://savannah.nongnu.org/projects/erbot") +(defconst erbmsg-version + "Version 0.2 $Revision: 1.26 $") + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +;; See also: + +;;; Comments: + +;; - To automagically save the whole message table with each incoming message +;; put following to your .erbot: +;; +;; (add-hook 'erbmsg-new-msg-post-hook 'erbmsg-regular-dump) +;; +;; - To clean up message cookies with every flushed message, add +;; +;; (add-hook 'erbmsg-flush-post-hook 'erbmsg-garbage-cleanse-cookies) + + +;;; TODOs that have been done: + +;; 2004/06/22: +;; - added dump routines to dump message hash tables to hard disk +;; - added routines for restoring from dumped message files +;; - added interval within erbot does not notify on channel joins +;; - added erbmsg-new-msg-(pre|post)-hook +;; 2004/04/09: +;; - added support for multiple recipients (see fs-memo for syntax) +;; - abstracted fs-memo stuff to two defuns (erbmsg-memo-parse-msg and erbmsg-memorize-msg) +;; 2004/04/01: +;; - added hooks +;; 2004/03/31: +;; - store which channel the memo came from +;; - added garbage collection function (erbmsg-garbage-cleanse-cookies) to +;; clean up erbmsg-msg-cookie-hash-table from unreferenced cookies + +;;; TODO: +;; - functionality to forget the erbmsg-question-* pile effectively +;; - save erbmsg-msg-hash-table across sessions +;; - expire cookies in erbmsg-msg-cookie-hash-table some time (after 3 notifications?) + +;;; Data + + +(defvar erbmsg-msg-hash-table (make-hash-table :test 'equal) + "This is a hash-table holding all the messages via cookies.") + +(defvar erbmsg-internal-msg-cookie nil + "Message cookie for internal communication.") + +(defvar erbmsg-msg-cookie-hash-table (make-hash-table :test 'equal) + "This is the hash-table for message cookies, the actual +messages are saved here") + +(defgroup erbmsg nil + "The erbmsg module for erbot" + :group 'erbot) + +(defcustom erbmsg-default-magic-words nil + "List of default magic words for messages with magic words." + :group 'erbmsg) + + +;;; dump settings + +(defcustom erbmsg-dump-file "~/public_html/data/messages.dump" + "File to dump message hash tables to." + :group 'erbmsg) + +(defcustom erbmsg-auto-restore-message-tables t + "Whether to automagically restore contents of `erbmsg-dump-file'." + :group 'erbmsg + :type 'boolean) + +(defcustom erbmsg-auto-dump-message-tables nil + "Whether to automagically dump hash tables to `erbmsg-dump-file'." + :group 'erbmsg + :type 'boolean) + + + +;;; uncomment this to normalize to UTC +;;(set-time-zone-rule "UTC0") + +(defvar erbmsg-after-load-hook nil + "Hook called after `erbmsg' has been loaded.") + +(defvar erbmsg-new-msg-pre-hook nil + "Hook called before a new message has been posted. +The raw message is passed as argument.") +(defvar erbmsg-new-msg-post-hook + (when erbmsg-auto-dump-message-tables + '(erbmsg-regular-dump)) + "Hook called after a new message has been posted. +The parsed message \(split to nicks and actual message text\) +is passed as argument.") +(defvar erbmsg-flush-pre-hook nil + "Hook called before erbmsg-flush-pending-msgs is called.") +(defvar erbmsg-flush-post-hook nil + "Hook called before erbmsg-flush-pending-msgs is called.") + + +;;; this is too useful to not add it here +(add-hook 'erbmsg-flush-post-hook 'erbmsg-garbage-cleanse-cookies) + + +;; interface functions +(defun fs-memo (&rest msg) + "Specify your message and the nick to dedicate to here, as in: + +#somechan> ,memo somenick hello somenick, don't forget + +Allowed syntaxes: +,memo [to|for] <nick> msg +,memo [to|for] <nick> <nick> <nick>: msg + +Note: magic words are not currently implemented." + (or (and erbot-erbmsg-p + msg + (let* ((msg-raw (erbutils-stringize msg)) + (nicks+msg (erbmsg-memo-parse-msg msg-raw))) + (run-hook-with-args 'erbmsg-new-msg-pre-hook msg-raw) + (mapc (lambda (nick+msg) + (let* ((nick (car nick+msg)) + (msg (nth 1 nick+msg))) + (erbmsg-memorize-msg nick msg))) + nicks+msg) + (run-hook-with-args 'erbmsg-new-msg-post-hook nicks+msg) + "msg memorized for delivery")) + (if msg (format "error: %S NOT parsed") (fs-memos)) + 'noreply)) +(defalias 'fs-msg-wmw 'fs-memo) ;; just for compatibility +(defalias 'fs-msg-with-magic-words 'fs-memo) + + +(defun erbmsg-memo-parse-msg (raw-msg) + "Parses MSG for any of the allowed memo syntaxes and returns a list +\(\(nick msg) (nick msg) ...)" + (let* ((nick-msg (cond ((string-match "^\\(?:to\\|for\\)?\\b\\(.+\\)\\b:\\(.*\\)" raw-msg) + (cons (match-string 1 raw-msg) (match-string 2 raw-msg))) + ((string-match "^\\(?:to\\|for\\)?\\(?:\\s-\\|\\b\\)\\(\\S-+\\)\\s-\\(.*\\)" raw-msg) + (cons (match-string 1 raw-msg) (match-string 2 raw-msg))) + (t nil))) + (nicks (split-string (replace-regexp-in-string ",\\|\\band\\b" "" (car nick-msg)))) + (msg (replace-regexp-in-string "^\\s-+" "" (cdr nick-msg)))) + (mapcar (lambda (nick) + (list nick msg)) + nicks))) +;;(erbmsg-memo-parse-msg "hroptatyr and deego: huhu! :)") + +(defun erbmsg-memorize-msg (nick msg &optional magic-words) + "Memorizes NICKs MSG." + (let* ((nicks-ht (or (gethash nick erbmsg-msg-hash-table) + (puthash nick + (make-hash-table :test 'equal) + erbmsg-msg-hash-table))) + (cnick fs-nick) + (cchan fs-tgt) + (ctime (current-time)) + ;; composition of the new memo + (newmsg (vector cnick cchan msg ctime magic-words)) + (newcookie (erbmsg-generate-msg-cookie newmsg)) + ;; now memos from that user already in the system + (cmsgs (gethash cnick nicks-ht))) + (add-to-list 'cmsgs newcookie) + (puthash cnick cmsgs nicks-ht))) + + + +(defun fs-memos (&rest line) + "This is redundant but more clean than in `erbmsg-parse'." + (and erbot-erbmsg-p + (let* ((linecar (car line)) + (internalp (and erbmsg-internal-msg-cookie + (eq linecar ':internal) + (eq erbmsg-internal-msg-cookie (cadr line)))) + (nick (or (and internalp + (car (cdr-safe (cdr-safe line)))) + fs-nick)) + (fromnicks (and (null internalp) + (mapcar (lambda (s) (format "%s" s)) line))) + (nicks-ht (gethash nick erbmsg-msg-hash-table)) + pending-msgs) + (and nicks-ht + (maphash (lambda (fromnick msg-cookies) + (setq pending-msgs + (append pending-msgs (or (and (null fromnicks) + msg-cookies) + (and (member fromnick fromnicks) + msg-cookies))))) + nicks-ht)) + (or (and pending-msgs + (let ((msg-cookie)) + (format "erm, %s, %s msgs pending, see them? %s" + nick + (length pending-msgs) + (erbmsg-question `((notice (erbmsg-notice-pending-msgs ,nick ',pending-msgs)) + (query (erbmsg-query-pending-msgs ,nick ',pending-msgs)) + (post (erbmsg-post-pending-msgs ,nick ',pending-msgs)) + (flush (erbmsg-flush-pending-msgs ,nick ',pending-msgs)) + (no (ignore)) + (memo-help (erbmsg-help))) + nick)))) + (and (null internalp) + (format ":( no msgs for you, %s\n%s" nick + (fs-describe "help-memo"))))))) +(defalias 'fs-msg-mymsgs 'fs-memos) +(defalias 'fs-mymemos 'fs-memos) +(defalias 'fs-msgs 'fs-msg-mymsgs) +(defalias 'fs-mymsgs 'fs-msg-mymsgs) + +(defun fsi-erbmsg-version (&rest ignore) + "Spits out `erbmsg-version'." + erbmsg-version) +(defalias 'fs-msg-version 'fs-erbmsg-version) + + +(defcustom erbmsg-notify-on-join-timeout 2 + "Interval in seconds to wait between notification on channel joins." + :group 'erbmsg) + +(defvar erbmsg-last-nicks-join nil + "List of nicks with last join time.") + +(defun erbmsg-put-alist (item value alist) + "Modify ALIST to set VALUE to ITEM. +If there is a pair whose car is ITEM, replace its cdr by VALUE. +If there is not such pair, create new pair (ITEM . VALUE) and +return new alist whose car is the new pair and cdr is ALIST. +\[tomo's ELIS like function]" + (let ((pair (assoc item alist))) + (if pair + (progn + (setcdr pair value) + alist) + (cons (cons item value) alist) + ))) + +(defun erbmsg-set-alist (symbol item value) + "Modify a alist indicated by SYMBOL to set VALUE to ITEM." + (or (boundp symbol) + (set symbol nil)) + (set symbol (erbmsg-put-alist item value (symbol-value symbol)))) + +(defun erbmsg-notify-msg-on-JOIN (process parsed) + "Notifies users about left messages +when joining the channel" + (and erbot-erbmsg-p + (let* ((usernickhost (if erbot-on-new-erc-p + (erc-response.sender parsed) + (aref parsed 1))) + (channel (if erbot-on-new-erc-p + (nth 0 (erc-response.command-args parsed)) + (aref parsed 2))) + (nick (car (erc-parse-user usernickhost))) + (last-access (cdr-safe (assoc nick erbmsg-last-nicks-join)))) + (erbmsg-set-alist 'erbmsg-last-nicks-join nick (current-time)) + (setq erbmsg-internal-msg-cookie (random)) + (let* ((msgs (fs-msg-mymsgs :internal erbmsg-internal-msg-cookie nick))) + (and msgs + (or (null last-access) + (> (- (nth 1 (current-time)) (nth 1 last-access)) + erbmsg-notify-on-join-timeout)) + (erc-message "PRIVMSG" + (format "%s %s" + channel + msgs))) + 'noreply)))) +(if (and (boundp 'erbot-on-new-erc-p) erbot-on-new-erc-p) + (add-hook 'erc-server-JOIN-functions 'erbmsg-notify-msg-on-JOIN) + (add-hook 'erc-server-JOIN-hook 'erbmsg-notify-msg-on-JOIN)) + + + +(defun erbmsg-parse (msg proc nick tgt localp userinfo) + "When having (require 'erbmsg) and (setq erbot-erbmsg-p t) +this function is called with every message typed. + +It checks for `nick' being in `erbmsg-msg-hash-table', +if so, i.e. `nick' is about to have messages pending for delivery, +it will be checked here if `nick' says the ~magic words~, +if that's also the case, the message will be spit out. + +Currently this function also plays the role as question handler, +see erbmsg-question part below :)." + (let* ((nicks-ht (gethash nick erbmsg-msg-hash-table)) + (pending-msgs) + + ;; now the stuff for question handling + (nicks-q-ht (gethash nick erbmsg-question-hash-table)) + (pending-actions)) + + ;; erbmsg-question handling + (and nicks-q-ht + (maphash (lambda (keyword action-forms) + (and (string-match (format "\\b%S\\b" keyword) + msg) + (let ((func (intern (format "fs-%s" keyword)))) + (and (fboundp func) + (funcall func))))) + nicks-q-ht)))) + + +(defun erbmsg-generate-msg-cookie (message) + "Generates a message cookie for `message' and returns it." + (let* ((msg-cookie (format "%.4x%.4x" + (mod (random) 65536) (mod (random) 65536)))) + (puthash msg-cookie message erbmsg-msg-cookie-hash-table) + msg-cookie)) + +(defun erbmsg-get-msgs (msg-cookies) + "Gets messages by `msg-cookie'." + (mapcar (lambda (msg-cookie) + (gethash msg-cookie erbmsg-msg-cookie-hash-table)) + msg-cookies)) + + +;; reply functions +(defun erbmsg-notice-pending-msgs (nick msg-cookies) + "NOTICEs all `msgs' to the user `nick'." + (erbmsg-send-pending-msgs nick msg-cookies "NOTICE" nick)) + +(defun erbmsg-query-pending-msgs (nick msg-cookies) + "PRIVMSGs all `msgs' to the user `nick'." + (erbmsg-send-pending-msgs nick msg-cookies "PRIVMSG" nick)) + +(defun erbmsg-post-pending-msgs (nick msg-cookies) + "Publically post all `msgs' to current channel" + (erbmsg-send-pending-msgs nick msg-cookies "PRIVMSG" fs-tgt)) + +(defun erbmsg-send-pending-msgs (nick msg-cookies &optional method target) + "PRIVMSGs all `msgs' to the user `nick', +instead of PRIVMSG you may specify another sending method." + (let ((msgs (erbmsg-get-msgs msg-cookies)) + (method (or method "PRIVMSG")) + (target (or target fs-nick))) + (and msgs + (mapc (lambda (msg) + (or (and msg + (let ((msgfrom (aref msg 0)) + (msgchan (aref msg 1)) + (msgtext (aref msg 2)) + (msgtime (aref msg 3))) + (erc-message method + (format "%s %s@%s %s: %s" + target + msgfrom + msgchan + (format-time-string "%D %T (%Z)" msgtime) + msgtext)))) + (erc-message method (format "%s invalid message cookie" target)))) + msgs)))) + +(defun erbmsg-flush-pending-msgs (nick msg-cookies) + "Flushes all pending messages for user `nick'." + (run-hook-with-args 'erbmsg-flush-pre-hook nick msg-cookies) + (erbmsg-flush-msg-cookies msg-cookies) + (remhash nick erbmsg-msg-hash-table) + (remhash nick erbmsg-question-hash-table) + (erc-send-message "flushed") + (run-hook-with-args 'erbmsg-flush-post-hook nick msg-cookies)) + +(defun erbmsg-flush-msg-cookie (msg-cookie) + "Flushes `msg-cookie'." + (remhash msg-cookie erbmsg-msg-cookie-hash-table)) +(defun erbmsg-flush-msg-cookies (msg-cookies) + "Flushes a collection of `msg-cookies'." + (mapc 'erbmsg-flush-msg-cookie msg-cookies)) + + +(defun erbmsg-help (&rest ignore) + "Spits out some detour to the wiki help page." + (erc-send-message "help? whom to help? see http://www.emacswiki.org/cgi-bin/wiki/ErbMsg")) + + + + + +;; garbage collection + +(defun erbmsg-garbage-cleanse-cookies (&rest ignore) + "Collects garbage from `erbmsg-msg-cookie-hash-table' when +there's no referring entry in `erbmsg-msg-hash-table'." + (maphash (lambda (cookie-k cookie-v) + (let ((cookie cookie-k) + (referred)) + (catch 'ref-exists-p + (maphash (lambda (memo-k memo-v) + (maphash (lambda (from cookie-list) + (and (member cookie cookie-list) + (setq referred t) + (throw 'ref-exists-p t))) + memo-v)) + erbmsg-msg-hash-table)) + (unless referred + (remhash cookie erbmsg-msg-cookie-hash-table)))) + erbmsg-msg-cookie-hash-table)) +;; erbmsg-msg-cookie-hash-table +;; (erbmsg-garbage-cleanse-cookies) + + + + + +;;; just some tricks to create gazillions of msgs w/o IRC +;; (clrhash erbmsg-msg-hash-table) +;; (puthash "hroptatyr" (make-hash-table :test 'equal) erbmsg-msg-hash-table) +;; (puthash "asathor" '("22224444" "33336666") (gethash "hroptatyr" erbmsg-msg-hash-table)) + + + + + + + +;;; this will get more abstract and move to an own modules soon :) +(defvar erbmsg-question-hash-table (make-hash-table :test 'equal) + "Hash table to hold who may be about to have the choice.") + +(defvar erbmsg-question-verbosity nil + "Controls how talkative erbot is when being in question mode.") + +(defvar erbmsg-question-handler nil + "command temporarily bound to certain users.") + +(defun erbmsg-question (choices nick) + "Declares choices for interactively control erbot's +more complex tasks. + +`choices' is an alist (action action-forms), +`action-forms' will be eval'd if nick uses the magic word once again." + (let* ((nicks-ht (puthash nick (make-hash-table :test 'equal) erbmsg-question-hash-table))) + (mapc (lambda (choice) + (let* ((magic-word (car choice)) + (action-forms (cdr choice)) + (internal-name (intern (format "fs-%s" magic-word)))) + (and ;;(not (fboundp internal-name)) + (fset internal-name + `(lambda (&rest ignore) + (and (erbmsg-question-user-allowed-p fs-nick ',magic-word) + (mapc 'eval ',action-forms)) + (erbmsg-question-user-answer fs-nick ',magic-word)))) + (puthash magic-word action-forms nicks-ht))) + choices) + (format "[type %s]" + (mapconcat (lambda (choice) + (format "%s%s" + erbn-char + (car choice))) + choices "/")))) + +;;(symbol-function 'fs-flush) + + +(defun erbmsg-question-user-allowed-p (nick erbot-command) + "Tests whether the user `nick' is allowed to use `erbot-command', +i.e. if the user has been offered such an action." + (let* ((nicks-ht (gethash nick erbmsg-question-hash-table)) + (command-p (and nicks-ht + (gethash erbot-command nicks-ht)))) + (null (null command-p)))) +(defun erbmsg-question-user-answer (nick erbot-command &optional answer) + "Tests whether the user `nick' is allowed to use `erbot-command', +if so return 'noreply, if not return an according answer." + (or (and (not (erbmsg-question-user-allowed-p nick erbot-command)) + 'noreply) ;;; "You are currently not allowed to use this function. :(") + 'noreply)) + + +;;; dumping code +;; this code is to make erbot remember messages after restarts + +(defun erbmsg-regular-dump (&rest ignore) + "Fun wrapper to call `erbmsg-dump-tables'." + (interactive) + (erbmsg-dump-tables)) + +(defun erbmsg-dump-tables (&optional file) + "Dumps known message hash tables to a buffer in order to save it." + (interactive "Ferbmsg dump file: ") + (let ((file (or file + erbmsg-dump-file))) + (with-temp-buffer + (mapc (lambda (htable) + (insert (format "[%s \n [\n" htable)) + (maphash + (lambda (key val) + (insert + (format " [%S %s]\n" key + (cond + ((hash-table-p val) + (let (valstring) + (maphash + (lambda (k2 v2) + (setq valstring + (format "%s[%S %S]" + (or valstring "") k2 v2))) + val) + (format "(%s)" valstring))) + (t (format "%S" val)))))) + (eval htable)) + (insert (format " ]\n]\n"))) + '(erbmsg-msg-hash-table erbmsg-msg-cookie-hash-table)) + (write-file erbmsg-dump-file)))) + +(defun erbmsg-restore-tables (&optional file) + "Restores known message hash tables from FILE or `erbmsg-dump-file'." + (interactive "ferbmsg dump file: ") + (let* ((file (or file + erbmsg-dump-file)) + (file-vector + (and (file-readable-p file) + (with-temp-buffer + (insert-file-contents file) + (eval (erbn-read (format "(setq file-vector '(%s))" + (erbutils-buffer-string)))))))) + (mapvector + (lambda (tablevector) + (let ((table (aref tablevector 0)) + (vector (aref tablevector 1))) + (mapvector + (lambda (keyval) + (let ((key (aref keyval 0)) + (val (aref keyval 1))) + (cond ((listp val) + (let ((nickht (make-hash-table :test 'equal))) + (mapc + (lambda (htvec) + (let ((k2 (aref htvec 0)) + (v2 (aref htvec 1))) + (puthash k2 v2 nickht))) + val) + (puthash key nickht (eval table)))) + (t (puthash key val (eval table)))))) + vector))) + file-vector))) + +(when (and erbot-erbmsg-p + erbmsg-auto-restore-message-tables + ;;(eq (hash-table-count erbmsg-msg-hash-table) 0) + ) + (erbmsg-restore-tables)) + + +(provide 'erbmsg) + +;;; erbmsg.el ends here + +;; Local variables: +;; indent-tab-mode: nil +;; End: diff --git a/elisp/erbot/erbot-lispy.el b/elisp/erbot/erbot-lispy.el new file mode 100644 index 0000000..a63ba4c --- /dev/null +++ b/elisp/erbot/erbot-lispy.el @@ -0,0 +1,89 @@ +;;; erbot-lispy.el --- ErBot integration in Lispy +;; Time-stamp: <2006-04-20 14:14:33 deego> +;; Emacs Lisp Archive entry +;; Filename: erbot-lispy.el +;; Package: erbot +;; Authors: Yann Hodique <hodique@lifl.fr> +;; Version: 0.0 +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot + +;; Lispy can be found at http://mtpforge.melting-pot.org/projects/lispy + +;; Installation +;; put an additional (require 'erbot-lispy) in you erbot's .emacs +;; *before* running (erbot-install) +;; then launch a lispy session + +(require 'lispy) +(require 'erbot) + +(defvar backup-buffer nil) + +(defun erbot-lispy-remote (line) + (let* ((nick nil) + (tgt nil) + (msg nil)) + + (cond + ((string-match "^<Mtp> \\(\\w+\\) tells you: \\(.*\\)$" line) + (setq nick (match-string 1 line)) + (setq tgt nick) + (setq msg (match-string 2 line))) + ((string-match (format "^<\\(Mtp\\|%s\\)>.*$" lispy-remote-user) line) + nil) + ((string-match "^<\\(\\w+\\)> \\(.*\\)$" line) + (setq nick (match-string 1 line)) + (setq tgt "#chan") + (setq msg (match-string 2 line))) + ) + (setq backup-buffer (current-buffer)) + (when (and lispy-connected nick) + (progn + (setq erbot-end-user-nick-latest nick) + (setq fs-tgt tgt) + (setq erbn-tgt tgt) + + (setq fs-nick nick) + (setq erbn-nick nick) + + (let ((msgg + (erbeng-main msg nil nick tgt nil (list nick nick nick)))) + + (cond + (erbot-quiet-p nil) + ((and erbot-quiet-target-p-function + (funcall erbot-quiet-target-p-function tgt nick msg)) + nil) + (t (erbot-lispy-reply msgg tgt))) + )))) + nil + ) + +(defun erbot-lispy-reply (main-reply tgt) + (unless (stringp main-reply) + (setq main-reply (format "%S" main-reply))) + (let ((reply (erbot-frob-with-init-string main-reply))) + (unless + (or + (null erbot-reply-p) + (equal main-reply 'noreply) + (equal main-reply "noreply")) + ;; now we are actually gonna reply. + (setq reply (fs-limit-lines reply)) + (set-buffer backup-buffer) + (let ((lines (split-string reply "\n"))) + (mapc + (lambda (line) + (lispy-message (concat (if (string-match "^#" tgt) + (if (erbot-lispy-safe-p line) "" " ") + (format "tell %s " tgt)) line "\n"))) + lines))))) + +;; Mtp does not use prefixed commands, activate the right ones via aliases +(defun erbot-lispy-safe-p (msg) + (string-match "^/" line)) + +(defadvice erbot-install (after ad-erbot-install-lispy-after act) + (add-hook 'lispy-post-insert-hook 'erbot-lispy-remote)) + +(provide 'erbot-lispy) diff --git a/elisp/erbot/erbot.el b/elisp/erbot/erbot.el new file mode 100644 index 0000000..9769dbf --- /dev/null +++ b/elisp/erbot/erbot.el @@ -0,0 +1,961 @@ +;;; erbot.el --- Another robot for ERC. +;; Time-stamp: <2009-09-26 22:28:50 fledermaus> +;; Emacs Lisp Archive entry +;; Filename: erbot.el +;; Package: erbot +;; Authors: David Edmunston (dme@dme.org) +;; Modified by: D. Goel <deego@gnufans.org>, V Dasmohapatra <vivek@etla.org> +;; Version: 0.0 +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot +;; Maintainer: Deepak Goel <deego@gnufans.org> + + +(defvar erbot-home-page + "http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot/") + +;; Version: +;; Keywords: ERC, IRC, chat, robot, bot + +;; Copyright (C) 2002 Deepak Goel, FSF + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + + + +;; See also: +;; erc-robot.el from which this was derived... + + + + +;; See http://www.emacswiki.org/cgi-bin/wiki/ErBot + +;; OLD DOCS: +;; Thanks for erbot's/erbot's behavior and their data go to a lot +;; of people on #emacs, like: +;; kensanata (Alex Schroeder) +;; resolve (Damien Elmes) +;; bpt (Brian P. Templeton) +;; forcer (Jorgen "forcer" Schaefer) +;; and many others + +;; and also to bot(s): +;; apt on debian, for english syntax examples. + +;; Thanks for code go to: +;; David Edmonsdon (who wrote erc-robot.el which is what this started +;; out from). +;; Nick Hober (who wrote google.el) + + + + + + +;;; David E's Commentary: + +;; erbot is a derivative of David's erc-robot.el --- that code was +;; copied over on 2002-09-02 into erbot.el. Erbot seeks to make the +;; bot similar to apt on #debian.. viz: English style.. yet allowing +;; access to commands via the "cmd" command. Erbot shall seek to +;; save all its information periodically, and publicly... + + +;; Erc-robot implements a simple robot for ERC. + +;; Installation: + +;; The robot uses hooks to gain access to ERC. The following need to +;; be executed after ERC has loaded: + +;; (load-library "erbot") + + +;; It is particularly important that the remote robot function is added +;; to the tail of the PRIVMSG hook. + +;; Robot commands are declared using the list "erbot-commands". +;; XXX better description of the functions. +;; An example might be: + +;; (setq erbot-commands +;; '( +;; ("cmds" t (lambda (args) +;; (concat "commands available: " +;; (mapconcat +;; (lambda (e) +;; (car e)) +;; erbot-commands " ")))) +;; ("hello" t (lambda (args) "hello to you too !")) +;; ("zippy" t (lambda (args) (erc-replace-regexp-in-string "\n" " " (yow)))) +;; ("music" t (lambda (args) (concat "now playing: " +;; (let ((track (dme:now-playing))) +;; (if track +;; track +;; "nothing."))))) +;; ("echo" t (lambda (args) args)) +;; ; only i'm allowed to talk to my doctor ! +;; ("doctor" nil erc-doctor) +;; ("version" t (lambda (args) (erc-version))) +;; )) + + +; compatability +;(if (featurep 'xemacs) +; (defun erc-replace-regexp-in-string +; (regexp rep string &optional fixedcase literal subexp start) +; (replace-in-string string regexp rep literal)) + +(defalias 'erc-replace-regexp-in-string 'replace-regexp-in-string) + +(defvar erbot-paranoid-p t + " Meant as a CATCHALL for security. Setting this variable to non-nil +should disable most features. When non-nil, all potentially funny +functions are disabled. We think these functions are safe, but we +disable them in any case. We also disable all functions that we can +that may potentially freeze the bot or severly slow it down upon +receiving weird requests. + + +t by default. No enablings like erbot-setf-p, etc. will work +unless this is non-nil. If this is non-nil, erbot is paranoid, it will +not allow apply, setf, funcall, sregex, etc. even if the corresponding +variables are turned on. + +NOTE: Making this variable nil and later non-nil in the middle of a +running emacs session will NOT make your bot completely paranoid. You +need to have this function non-nil BEFORE you load erbot. See, for +example, how we define fs-kbd. +") + + + + +(defun erbot-commentary () + "Provides electric help regarding variable `erbot-commentary'." + (interactive) + (with-electric-help + '(lambda () (insert erbot-commentary) nil) "*doc*")) + +;;; History: + +;;; Bugs: + +;;; New features: +(defvar erbot-new-features + "Help..." +) + +(defun erbot-new-features () + "Provides electric help regarding variable `erbot-new-features'." + (interactive) + (with-electric-help + '(lambda () (insert erbot-new-features) nil) "*doc*")) + +;;; TO DO: +(defvar erbot-todo + "Current shortcomings:" + +) + +(defun erbot-todo () + "Provides electric help regarding variable `erbot-todo'." + (interactive) + (with-electric-help + '(lambda () (insert erbot-todo) nil) "*doc*")) + +(defvar erbot-version "0.0") + +;;========================================== +;;; Code: +(require 'cl) + +(defcustom erbot-before-load-hooks nil "" :group 'erbot) +(defcustom erbot-after-load-hooks nil "" :group 'erbot) + + + +(defcustom erbot-ignore-nicks '("^apt[0-9]?$" "bot" "google" "serv") + "A list of REGEXPS. +Nicks matching these regexps will be ignored by the bot, viz. not +generate replies. + +I would suggest including atleast bot, google and serv here to prevent +infinite chat loops with other bots. :) +" +:type '(repeat regexp) +:group 'erbot) + +(defcustom erbot-use-whitelist nil "Use a whitelist for accessing the bot. +Any request from another source will be ignored. If a source is present in whitelist +and in `erbot-ignore-nicks' it is ignored" +:type 'boolean +:group 'erbot) + +(defcustom erbot-whitelist-nicks nil +"List of the entries that have access to the bot. Used only when `erbot-use-whitelist' is non-nil" +:type '(repeat regexp) +:group 'erbot) + +(defcustom erbot-ignore-userinfos "" "list of regex's" :group 'erbot) +(run-hooks 'erbot-before-load-hooks) + + +(defgroup erbot nil + "The group erbot" + :group 'applications) + +(defcustom erbot-nick "fsbot" +"Changing this in the middle of things +may have unspecified and unpleasant results..." +:group 'erbot) + +(defvar erbot-end-user-nick "dummy-nick" + "just a temporary variable..") + +(defvar erbot-end-user-nick-latest "dummy-end-user-nick-latest" + "just a temporary variable..") + + + + + +(defcustom erbot-servers-channels + '(("irc.openprojects.net" + ("#testopn" + )) + (".gnome.org" + ("#testgnome") + ;; optional but: + 6667 + )) + "Servers and channels ..." + :group 'erbot) + + + +; (defalias 'erc-replace-regexp-in-string 'replace-regexp-in-string)) + + +(defface erbot-face '((t (:foreground "yellow"))) + "Face used for your robot's output." + :group 'erc-faces) + +(defcustom erbot-commands nil + "A list of robot commands and the functions which implement them." + :group 'erc + :type '(repeat (list string (choice (const nil) (const t) string) function)) + ) + + + +(defcustom erbot-erbmsg-p nil + "When true, erball.el loads the erbmsg module by default ") + + +(defcustom erbot-notify-p t + "Set it to t if you want RSS notification +for your erbot. + +Note that even if it is t, we will internally setq it to nil temporarily during +the inner workings of the bot. ") + +;; The next part suggested by forcer, See +;; http://www.kollektiv-hamburg.de/~forcer/erbot-notify.txt, which is +;; also copied here: + +;; erbot should include the following function lists, which are +;; called on these events with the specified arguments: + +;; erbot-notify-add-functions +;; arguments: nick channel term entry-num entry + +(defvar erbot-notify-add-functions nil + "Functions to call when an erbot add takes place. Each of these is +called with the arguments arguments: nick channel term entry-num +entry") + +;; erbot-notify-forget-functions +;; arguments: nick channel term entry-num entry +;; If entry-num is 'all, entry is a list of entries + + +;; SPECS CHANGED! +(defvar erbot-notify-forget-functions nil + "Functions to call when an erbot forget takes place. Each of these +is called with the arguments arguments: nick channel term entry-num +entry remaining-entries. If entry-num is 'all, entry is a list of +entries") + +;; erbot-notify-move-functions +;; arguments: nick channel old-term new-term + +(defvar erbot-notify-move-functions nil + "Functions to call when an erbot move operation takes place. Each +of these is called with the arguments arguments: nick channel old-term +new-term ") + +;; erbot-notify-rearrange-functions +;; arguments: nick channel term from-num from-entry to-num +;; entries + +(defvar erbot-notify-rearrange-functions nil + "Functions to call when an erbot rearrange operation takes place. Each +of these is called with the arguments arguments: nick channel term +from-num from-entry to-num entries. Entries refers to the rearranged +entries. ") + + +;; erbot-notify-substitute-functions +;; arguments: nick channel term entry-num old-entry new-entry +(defvar erbot-notify-substitute-functions nil + "Functions to call when an erbot substitute operation takes place. +Each of these is called with the arguments arguments: nick channel +term entry-num old-entry new-entry") + +;;; 2005-08-31 T10:56:27-0400 (Wednesday) D. Goel +(defvar erbot-nickserv-p nil + "When t, erbot will load the appropriate erc modules and will try to +auto-identify to nickserv. + +If using this, we recommend these settings at the *BEGINNING* of your +bot's .emacs: + + (setq erbot-nickserv-p t) + (setq erc-prompt-for-nickserv-password nil) + + (setq erc-nickserv-passwords + '((freenode ((\"mybot\" . \"mypassword\"))))) + +See this page for more details: +http://www.emacswiki.org/cgi-bin/wiki?ErcNickserv +") + +(when erbot-nickserv-p + (require 'erc-nickserv nil t) ;; old erc + (require 'erc-services nil t) ;; erc from emacs22 + (erc-nickserv-mode 1) + ) + + + + +;; erbot-notify-merge-functions +;; arguments: nick channel old-term new-term new-entries +;; NOW CHANGED SPEC! +(defvar erbot-notify-merge-functions nil + "Functions to call when an erbot merge operation takes place. +Each of these is called with the arguments arguments: nick channel +from-term to-term from-entries to-entries final-entries") + + + +; This function is used by the example above. +(defun erbot-doctor (args) + "Glue the doctor into the ERC robot." + (let* ((thisbuf (current-buffer)) + (dbuf (concat "*doctor: " (buffer-name thisbuf) "*")) + (docbuf (get-buffer dbuf)) + outpoint + res) + (if (not docbuf) + (progn + (set-buffer (get-buffer-create dbuf)) + (make-doctor-variables) + (set-buffer thisbuf) + (setq docbuf (get-buffer dbuf)) + (bury-buffer docbuf))) + (save-excursion + (set-buffer docbuf) + (goto-char (point-max)) + (insert args) + (goto-char (point-max)) + (setq outpoint (point)) + (doctor-ret-or-read 1) + (doctor-ret-or-read 1) + (goto-char outpoint) + (re-search-forward "^.") + (setq outpoint (- (point) 1)) + (re-search-forward "^$") + (erc-replace-regexp-in-string + "\n" " " (buffer-substring outpoint (point))) + ))) + + + +(defun erbot-dunnet (arg) + "Glue the dunnet into the ERC robot." + (save-excursion + (let ((freshp nil) + outpoint res ans + (pre "") + full + ) + (when (or (not (boundp 'dun-dead)) dun-dead + (not (get-buffer "*dungeon*")) + ) + (setq freshp t) + (setq dun-dead nil)) + (when freshp (dunnet)) + (set-buffer "*dungeon*") + (goto-char (point-max)) + (when (string-match "save" arg) + (setq arg "save ~/pub/dunnet/dunnet.game") + (setq pre "Will save to ~/pub/dunnet/dunnet.game")) + (cond + ((string-match "^.?more" arg) + (setq ans (fsi-more))) + (t + (unless freshp (insert arg)) + (goto-char (point-max)) + (setq outpoint (if freshp (point-min) (point))) + (unless freshp (dun-parse 1)) + (setq ans + (buffer-substring-no-properties + outpoint (- (point-max) 1))) + (when (equal arg "quit") + (when (kill-buffer "*dungeon*"))))) + (setq full (concat pre ans)) + (when + (string-match + "I don't understand that" + full) + (setq + full + (concat + full + " I am in dunnet mode. For regular fsbot, type , (dunnet-mode)"))) + full))) + +(defvar erbot-quiet-p nil + "When non-nil, the erbot only listens, never replies") +(defun erbot-quiet () + (interactive) + (setq erbot-quiet-p + (not erbot-quiet-p)) + (message "set to %S" erbot-quiet-p)) + +(defvar erbot-quiet-target-p-function nil + "A function. The function should take up to 3 arguments, TARGET +\(channel) , nick and msg. If it returns non-nil, then erbot will +listen and do everything but never reply back.") + + +(defvar erbot-on-new-erc-p nil + "Whether we use erc >1.660 with new erc-backend. +The value should not be set but is auto-guessed within +`erbot-install'.") + + +;; A very very main function.. +(defun erbot-remote (proc parsed) + "Implements a simple robot for erc. Messages to the robot are of the form: +\"nick: !command args\", where: +nick - the nickname of the user who is the target of the command, +command - the specific command, +args - arguments to the command (optional). + +For newer erc, see `erbot-on-new-erc-p' and read the specs of +the new erc-backend functions." + (set-buffer (process-buffer proc)) + (let* ( + (erbn-buffer (erc-server-buffer)) + (sspec (cond (erbot-on-new-erc-p + (erc-response.sender parsed)) + (t (aref parsed 1)))) + (userinfo (erc-parse-user sspec)) + (nick (erbutils-remove-text-properties-maybe (nth 0 userinfo))) + ;; bind fs-nick in a let.. so that changes to fs-nick are + ;; independent and do not affect each other.. when it is + ;; parsing too many messages once.. + (fs-nick nick) + (erbn-nick fs-nick) + (cmdargs (and erbot-on-new-erc-p + (erc-response.command-args parsed))) + (tgta + (erbutils-remove-text-properties-maybe + (cond (cmdargs + (nth 0 cmdargs)) + (t (aref parsed 2))))) + (tgt (if (equalp tgta (or (erc-current-nick) erbot-nick)) + nick + tgta)) + (erbn-tgt tgt) + (fs-tgt tgt) + (msg + (erbutils-remove-text-properties-maybe + (erc-response.contents parsed))) + (erbot-end-user-nick nick) + (csys (if (fboundp 'erc-coding-system-for-target) + (erc-coding-system-for-target tgt) + 'utf-8)) + (code-in (if (consp csys) (cdr csys) csys)) + (code-out (if (consp csys) (car csys) csys)) + ) + ;; changing the structure here.. + ;; also changing erbot-command to erbot-reply.. + ;; from now on, erend-main will take care of what to reply.. + ;; erbot-reply will simply take the reply and reply that... + ;; should not be setq.. else other invocations may change it.. + ;;(setq erbot-end-user-nick nick) + + (setq erbot-end-user-nick-latest erbot-end-user-nick) + ;;(setq fs-tgt tgt) + ;;(setq erbn-tgt tgt) + + ;;(setq fs-nick nick) + ;;(setq erbn-nick nick) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; make sure we decode the raw text we received... + (unless (multibyte-string-p msg) + (setq msg (decode-coding-string msg code-in))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (let ((msgg + (erbeng-main msg proc nick tgt nil userinfo))) + ;; erbot-reply needs a correct buffer... + (set-buffer (process-buffer proc)) + + (cond + (erbot-quiet-p nil) + ((and erbot-quiet-target-p-function + (funcall erbot-quiet-target-p-function tgt nick msg)) + nil) + (t (erbot-reply + msgg + proc erbn-nick erbn-tgt msg nil + ))) + + )) + nil) + + +(defun erbot-frob-with-init-string (reply) + (cond + ((or (not (stringp reply)) (string= erbot-init-string "")) reply) + (t + (with-temp-buffer + (insert reply) + (goto-char (point-min)) + (while (re-search-forward "\n" nil t) + (replace-match + (concat "\n" erbot-init-string) nil t)) + (concat erbot-init-string (erbutils-buffer-string)))))) + +(defvar erbot-init-string "" + "The basic init string.. should be concated to ALL lines of +replies... right at last.. the values it will hold will look like /msg +foo, and will be set by fs-parse-english, when that function +determines it appropriate.. +Currently: we do not use it, since we have found a better way to do +those things.. + +") + +;; this one is probably never used any more... just to make sure, +;; introduced an error command.. +;(defun erbot-local (str) +; "Funnel text typed by the local user to the local robot. See +;\"erbot-remote\" for details of the command format." +; (error "foo") +; (erbot-command erc-process (erc-current-nick) (buffer-name) str t)) + +(defcustom erbot-reply-p t + "when nil, don't reply") + +(defun erbot-toggle-reply () + (interactive) + (setq erbot-reply-p (not erbot-reply-p)) + (message "erbot-reply-p set to %S" erbot-reply-p) + ) +(defun erbot-reply (main-reply proc from tgt msg locally-generated) + "Robot worker. Should do nothing when main-reply is nil or 'noreply +or \"noreply\" + +" + (unless (stringp main-reply) + (setq main-reply (format "%S" main-reply))) + (let ( + linen + (me (or (erc-current-nick) erbot-nick)) + ;;(if (and erbot-commands + ;; (string-match (concat "^" (regexp-quote me) + ;; ": !\\([^ ]+\\) ?\\(.*\\)") msg)) + ;; ; this is a robot command to me. + ;; (let* ((cmd (substring msg (match-beginning 1) (match-end 1))) + ;; (args (substring msg (match-beginning 2))) + ;; (l (assoc cmd erbot-commands)) + ;; (allowed-users (nth 1 l)) + ;; (function (nth 2 l)) + ;; (permitted (or (eq t allowed-users) + ;; (and (eq nil allowed-users) locally-generated) + ;; (and (stringp allowed-users) + ;; (string-match allowed-users + ;; (regexp-quote from))))) + + + + ;;(reply (concat from ": " main-reply)) + ;; my frobbing of reply.. + (reply + (erbot-frob-with-init-string main-reply)) + + + (rep-buffer (erc-get-buffer tgt proc))) + ;;(if permitted + ;; (if l + ;; (funcall function args) + ;;(concat "unknown command: " cmd + ;; ": try \"cmds\"")) + ;; (concat "no access to command \"" cmd + ;; "\" for " from "."))))) + (erc-log reply) + + + (unless + (or + (null erbot-reply-p) + (equal main-reply 'noreply) + (equal main-reply "noreply")) + ;; now we are actually gonna reply. + (save-excursion + (setq reply (fs-limit-lines reply)) + (if rep-buffer (set-buffer rep-buffer) + ;;; this alternative reply somehow never gets sent out.. + ;;(setq reply (concat "msg " from " " + ;; "No private msgs.. try #testopn")) + ;;(set-buffer (erc-get-buffer tgt proc)) + (progn + (ding t) + (message "WTF? no rep-buffer? ")) + ) + + (let* ((inhibit-read-only t) + (lines (split-string reply "[\n\r]+")) + (multiline-p (< 1 (length lines))) + p) + (mapc + (lambda (line) + (when (and line + (not (erbot-safe-p line))) + (setq line (erbot-safe-make line))) + (goto-char (point-max)) + (setq p (re-search-backward (erc-prompt))) + ;;(insert (erc-format-timestamp) "<" me "> ") + (insert ;;(erc-format-timestamp) + "<" me "> ") + (erc-put-text-property 0 (length line) 'face + 'erbot-face line) + (insert line "\n") + (save-excursion + (save-match-data + (save-restriction + (narrow-to-region p (point)) + (run-hook-with-args 'erc-send-modify-hook) + (run-hook-with-args 'erc-send-post-hook)))) + (set-marker (process-mark erc-process) (point)) + (set-marker erc-insert-marker (point)) + (goto-char (point-max)) + (setq linen (concat line "\n")) + ;; fledermaus: I used to force the encoding here, but I now + ;; think that's the wrong thing to do. Hopefully if the data-path + ;; through erc->fsbot->erc is clean, erc will do the right thing + ;; to outbound data. + (erc-process-input-line linen nil multiline-p)) + lines)))))) + + +(defcustom erbot-setf-p nil + "If you want your bot to allow setf, set this symbol to non-nil at +the beginning of your .emacs") + + +(defcustom erbot-setf-symbols + '(caar cadr car cdar cddr cdr eighth elt + first fourth + ninth nth + nthcdr + second + seventh sixth + subseq substring + tenth third) +"Safe symbols for setf...") + + +;;;###autoload +(defun erbot-install () + "Run this function AFTER loading all the files..." + (interactive) + (setq erbot-on-new-erc-p + (and (boundp 'erc-server-PRIVMSG-functions) + (featurep 'erc-backend))) + (cond (erbot-on-new-erc-p + (add-hook 'erc-server-PRIVMSG-functions 'erbot-remote t) + ;; Do we need this local command thing...? + ;;(add-hook 'erc-send-completed-hook 'erbot-local t) + (add-hook 'erc-server-001-functions + 'erbot-autojoin-channels)) + (t + (add-hook 'erc-server-PRIVMSG-hook 'erbot-remote t) + ;; Do we need this local command thing...? + ;;(add-hook 'erc-send-completed-hook 'erbot-local t) + (add-hook 'erc-server-001-hook + 'erbot-autojoin-channels)) + ) + (erbot-install-symbols) + (when (and erbot-setf-p (not erbot-paranoid-p)) + (erbot-install-setf)) + ;; A running bot should have these nil, else userfunctions will not + ;; function right: + (setq eval-expression-print-length nil) + (setq eval-expression-print-level nil) + (setq print-length nil) + (setq print-level nil) + ) + + + +(defun erbot-install-setf () + (interactive) + (defalias 'fs-setf 'setf) + (require 'cl) + (let* + ( + ;; all possible symbols + ;;(syms + ;;(apropos-internal "" (lambda (a) (get a 'setf-method)))) + (syms erbot-setf-symbols) + (fssyms + (mapcar + (lambda (a) (intern (format "fs-%s" a))) + syms)) + (fsisyms + (mapcar + (lambda (a) (intern (format "fsi-%s" a))) + syms))) + (mapcar* + (lambda (a b c) + (let ((foo (get a 'setf-method))) + (when (fboundp b) (put b 'setf-method foo)) + (when (fboundp c) (put c 'setf-method foo)))) + syms fssyms fsisyms))) + + + + +(defun erbot-install-symbols () + "By now, you should have loaded all pertinent erbot files... If you +add any new functions, don't forget to run (erbot-install) AFTER +that.." + (interactive) + (let ((ss (fsi-command-list-readonly))) + (dolist (s ss) + + (if (symbolp s) + (let ((f-s (erbutils-concat-symbols 'fs- s)) + (fi-s (erbutils-concat-symbols 'fsi- s))) + + (defalias f-s fi-s) + (put f-s 'readonly t)) + (message "Ignoring fsi->fs for %s" s))))) + + + + +;;;###autoload +(defun erbot-autojoin-channels (server nick) + ;;(interactive) + (dolist (l erbot-servers-channels) + (when (string-match (car l) (process-name server)) + (dolist (chan (cadr l)) + (erc-send-command (concat "join " chan)))))) + + + +(defun erbot-get-servers () + (mapcar '(lambda (arg) (list (car arg) (caddr arg))) + erbot-servers-channels)) + + +;;;###autoload +(defun erbot-alive-p () + "Is atleast one connection still alive?" + ;;(require 'cl-extra) + (some + 'identity + (mapcar + (lambda (buf) + (save-excursion + (set-buffer buf) + (erc-process-alive))) + (erc-buffer-list)))) + +(defvar erbot-reconnection-attempts nil) + +;;;###autoload +(defun erbot-keep-alive (&rest args) + "Periodically check if atleast one connection is still alive. If +not, try to reconnect. " + (require 'idledo) + (idledo-add-periodic-action-crude + '(unless (erbot-alive-p) + (add-to-list 'erbot-reconnection-attempts + (message "Erbot trying to reconnect at %s" + (format-time-string + "%Y%m%d-%H%M-%S"))) + (ignore-errors (apply 'erbot-join-servers args))))) + +;;;###autoload +(defun erbot-join-servers (&optional server port nick + user-full-name + not-connect-arg passwd) + "Try to never join if already joined..." + (interactive) + (require 'erc) + (if (null server) + (mapcar + '(lambda (arg) + (erbot-join-servers + (car arg) (cadr arg) nick user-full-name not-connect-arg passwd) + (sit-for 1) + ) + + ;; get the list of servers + (erbot-get-servers) + + ) + (progn + ;;(if (null server) + ;; (setq server erc-server)) + ;; 2002-08-21 T11:22:35-0400 (Wednesday) D. Goel + (setq erc-current-server-my server) + (if (null port) + (setq port + (if (fboundp 'erc-compute-port) + (erc-compute-port) + erc-port))) + (setq nick (or erbot-nick (erc-compute-nick nick))) + (let* ( + (foo 'bar) + (version nil) + ;(nick + ; (if (erc-already-logged-in server port nick) + ;; (read-from-minibuffer + ;; (erc-format-message 'nick-in-use ?n nick) + ;; nick + ;; nil nil 'erc-nick-history-list) + ;; nick))) + ) + (if (and passwd (string= "" passwd)) + (setq passwd nil)) + ;; (while (erc-already-logged-in server port nick) + ;; (setq nick (read-from-minibuffer + ;; (erc-format-message 'nick-in-use ?n nick) + ;; nick + ;; nil nil 'erc-nick-history-list))) + + (run-hook-with-args 'erc-before-connect server port nick) + (if (string-match "\\(\\<[[:digit:]]+.[[:digit:]]+\\>\\)" + erc-version-string) + (setq version (string-to-number + (match-string 1 erc-version-string))) + (setq version 0)) + + (unless (erc-already-logged-in server port nick) + (if (<= 5.0 version) + (erc :server server + :port port + :nick nick + :password passwd + :full-name user-full-name) + (erc + server port nick user-full-name (not not-connect-arg) passwd) )) + )))) + + +(defun erbot-safe-make (line) + (let* ((ans line) + (rlist (string-to-list line))) + (when (string-match "^/" line) + (unless (string-match "^/me " line) + (setq ans (concat " " line)))) + (when (member-if (lambda (a) + (and (< a 32) + (not (= a 9)))) + rlist) + (setq ans "<control characters>")) + (when (string-match "[\n\r]" line) + (setq ans " <newlines> ")) + ans)) + + + + + +(defun erbot-safe-p (reply) + "Determine whether a reply is safe. Any newlines are simply +reported as unsafe. + +If this functions deems a reply as unsafe, you should not send it to +ERC but call `erbot-safe-make' first. " + (and + (not (string-match "[\n\r]" reply)) + ;; err on the side of caution. Demand that the 1st char. be VERY + ;; safe. + (or + (string-match "^[0-9a-zA-Z]" reply) + ;;(not (string-match "^/" reply)) -- this is bad.. since, control + ;;characters are bad... beginnning ^A for example, will send CTCP requests.. + + ;; Allow /me commands.. but only when the rest of the text has no + ;; control characters.. + (equal 0 (string-match "^/me " reply))) + ;; And there be no control characters whatsoever anywhere. + (erbot-safe-nocontrol-p reply))) + +(defun erbot-safe-nocontrol-p (reply) + (let ((rlist (string-to-list reply))) + (not (member-if (lambda (a) (< a 32)) rlist)))) + + + + + + +(defun erbot-dunnet-install () + "Defines some dunnet specific aliases. " + (interactive) + (require 'dunnet) + (defalias 'dun-read-line 'fs-botread) + ;;(defalias 'dun-mprinc + ;;'fs-dun-mprinc)) + ) + + +(defmacro erbot-working (&rest args) + `(let ((erbbdb-save-p nil) + (erbot-notify-p nil)) + ,@args)) + + + +(provide 'erbot) +(run-hooks 'erbot-after-load-hooks) + + + +;;; erbot.el ends here diff --git a/elisp/erbot/erbp.el b/elisp/erbot/erbp.el new file mode 100644 index 0000000..bc59be7 --- /dev/null +++ b/elisp/erbot/erbp.el @@ -0,0 +1,3376 @@ +;;; erbp.el --- not yet functional, personal erbot-interface, stolen from dunnet.el +;; we should perhaps remove this file, is not in use -- DG. + +;; Copyright (C) 1992, 1993, 2001 Free Software Foundation, Inc. + +;; Author: Ron Schnell <ronnie@driver-aces.com> +;; Created: 25 Jul 1992 +;; Version: 0.0dev +;; Keywords: games + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; For starters, namespaces: dun, dunnet, erbpeon, mostly get mapped +;; to erbp, erbpne and erbpeon respectively. +;; room-->erbp-room + +;;; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +;;; The log file should be set for your system, and it must +;;; be writable by all. + +;;; Code: + +(defgroup erbpnet nil + "Text adventure for Emacs." + :prefix "erbp-" + :group 'games) + +(defconst erbp-version "0.0dev") + +(defcustom erbp-log-file "/usr/local/erbpnet.score" + "Name of file to store score information for erbpnet." + :type 'file + :group 'erbpnet) + +(if nil + (eval-and-compile (setq byte-compile-warnings nil))) + +(eval-when-compile + (require 'cl)) + +;;;; Mode definitions for interactive mode + +(defun erbp-mode () + "Major mode for running erbpnet." + (interactive) + (text-mode) + (make-local-variable 'scroll-step) + (setq scroll-step 2) + (use-local-map erbpeon-mode-map) + (setq major-mode 'erbp-mode) + (setq mode-name "Erbpeon")) + +(defun erbp-parse (arg) + "Function called when return is pressed in interactive mode to parse line." + (interactive "*p") + (beginning-of-line) + (setq beg (+ (point) 1)) + (end-of-line) + (if (and (not (= beg (point))) (not (< (point) beg)) + (string= ">" (buffer-substring (- beg 1) beg))) + (progn + (setq line (downcase (buffer-substring beg (point)))) + (princ line) + (if (eq (erbp-vparse erbp-ignore erbp-verblist line) -1) + (erbp-mprinc "I don't understand that.\n"))) + (goto-char (point-max)) + (erbp-mprinc "\n")) + (erbp-messages)) + +(defun erbp-messages () + (if erbp-dead + (text-mode) + (if (eq erbpeon-mode 'erbpeon) + (progn + (if (not (= erbp-room erbp-current-room)) + (progn + (erbp-describe-room erbp-current-room) + (setq erbp-room erbp-current-room))) + (erbp-fix-screen) + (erbp-mprinc ">"))))) + + +;;;###autoload +(defun erbpnet () + "Switch to *erbpeon* buffer and start game." + (interactive) + (switch-to-buffer "*erbpeon*") + (erbp-mode) + (setq erbp-dead nil) + (setq erbp-room 0) + (erbp-messages)) + +;;;; +;;;; This section contains all of the verbs and commands. +;;;; + +;;; Give long description of room if haven't been there yet. Otherwise +;;; short. Also give long if we were called with negative room number. + +(defun erbp-describe-room (erbp-room) + (if (and (not (member (abs erbp-room) erbp-light-rooms)) + (not (member obj-lamp erbp-inventory))) + (erbp-mprincl "It is pitch dark. You are likely to be eaten by a grue.") + (erbp-mprincl (cadr (nth (abs erbp-room) erbp-rooms))) + (if (and (and (or (member erbp-room erbp-visited) + (string= erbp-mode "erbp-superb")) (> erbp-room 0)) + (not (string= erbp-mode "long"))) + nil + (erbp-mprinc (car (nth (abs erbp-room) erbp-rooms))) + (erbp-mprinc "\n")) + (if (not (string= erbp-mode "long")) + (if (not (member (abs erbp-room) erbp-visited)) + (setq erbp-visited (append (list (abs erbp-room)) erbp-visited)))) + (dolist (xobjs (nth erbp-current-room erbp-room-objects)) + (if (= xobjs obj-special) + (erbp-special-object) + (if (>= xobjs 0) + (erbp-mprincl (car (nth xobjs erbp-objects))) + (if (not (and (= xobjs obj-bus) erbp-inbus)) + (progn + (erbp-mprincl (car (nth (abs xobjs) erbp-perm-objects))))))) + (if (and (= xobjs obj-jar) erbp-jar) + (progn + (erbp-mprincl "The jar contains:") + (dolist (x erbp-jar) + (erbp-mprinc " ") + (erbp-mprincl (car (nth x erbp-objects))))))) + (if (and (member obj-bus (nth erbp-current-room erbp-room-objects)) erbp-inbus) + (erbp-mprincl "You are on the bus.")))) + +;;; There is a special object in the erbp-room. This object's description, +;;; or lack thereof, depends on certain conditions. + +(defun erbp-special-object () + (if (= erbp-current-room computer-room) + (if erbp-computer + (erbp-mprincl +"The panel lights are flashing in a seemingly organized pattern.") + (erbp-mprincl "The panel lights are steady and motionless."))) + + (if (and (= erbp-current-room red-room) + (not (member obj-towel (nth red-room erbp-room-objects)))) + (erbp-mprincl "There is a hole in the floor here.")) + + (if (and (= erbp-current-room marine-life-area) erbp-black) + (erbp-mprincl +"The room is lit by a black light, causing the fish, and some of +your objects, to give off an eerie glow.")) + (if (and (= erbp-current-room fourth-vermont-intersection) erbp-hole) + (progn + (if (not erbp-inbus) + (progn + (erbp-mprincl"You fall into a hole in the ground.") + (setq erbp-current-room vermont-station) + (erbp-describe-room vermont-station)) + (progn + (erbp-mprincl +"The bus falls down a hole in the ground and explodes.") + (erbp-die "burning"))))) + + (if (> erbp-current-room endgame-computer-room) + (progn + (if (not erbp-correct-answer) + (erbp-endgame-question) + (erbp-mprincl "Your question is:") + (erbp-mprincl erbp-endgame-question)))) + + (if (= erbp-current-room sauna) + (progn + (erbp-mprincl (nth erbp-sauna-level '( +"It is normal room temperature in here." +"It is luke warm in here." +"It is comfortably hot in here." +"It is refreshingly hot in here." +"You are dead now."))) + (if (= erbp-sauna-level 3) + (progn + (if (or (member obj-rms erbp-inventory) + (member obj-rms (nth erbp-current-room erbp-room-objects))) + (progn + (erbp-mprincl +"You notice the wax on your statuette beginning to melt, until it completely +melts off. You are left with a beautiful diamond!") + (if (member obj-rms erbp-inventory) + (progn + (erbp-remove-obj-from-inven obj-rms) + (setq erbp-inventory (append erbp-inventory + (list obj-diamond)))) + (erbp-remove-obj-from-room erbp-current-room obj-rms) + (erbp-replace erbp-room-objects erbp-current-room + (append (nth erbp-current-room erbp-room-objects) + (list obj-diamond)))))) + (if (or (member obj-floppy erbp-inventory) + (member obj-floppy (nth erbp-current-room erbp-room-objects))) + (progn + (erbp-mprincl +"You notice your floppy disk beginning to melt. As you grab for it, the +disk bursts into flames, and disintegrates.") + (erbp-remove-obj-from-inven obj-floppy) + (erbp-remove-obj-from-room erbp-current-room obj-floppy)))))))) + + +(defun erbp-die (murderer) + (erbp-mprinc "\n") + (if murderer + (erbp-mprincl "You are dead.")) + (erbp-do-logfile 'erbp-die murderer) + (erbp-score nil) + (setq erbp-dead t)) + +(defun erbp-quit (args) + (erbp-die nil)) + +;;; Print every object in player's inventory. Special case for the jar, +;;; as we must also print what is in it. + +(defun erbp-inven (args) + (erbp-mprinc "You currently have:") + (erbp-mprinc "\n") + (dolist (curobj erbp-inventory) + (if curobj + (progn + (erbp-mprincl (cadr (nth curobj erbp-objects))) + (if (and (= curobj obj-jar) erbp-jar) + (progn + (erbp-mprincl "The jar contains:") + (dolist (x erbp-jar) + (erbp-mprinc " ") + (erbp-mprincl (cadr (nth x erbp-objects)))))))))) + +(defun erbp-shake (obj) + (let (objnum) + (when (setq objnum (erbp-objnum-from-args-std obj)) + (if (member objnum erbp-inventory) + (progn +;;; If shaking anything will do anything, put here. + (erbp-mprinc "Shaking ") + (erbp-mprinc (downcase (cadr (nth objnum erbp-objects)))) + (erbp-mprinc " seems to have no effect.") + (erbp-mprinc "\n") + ) + (if (and (not (member objnum (nth erbp-current-room erbp-room-silents))) + (not (member objnum (nth erbp-current-room erbp-room-objects)))) + (erbp-mprincl "I don't see that here.") +;;; Shaking trees can be deadly + (if (= objnum obj-tree) + (progn + (erbp-mprinc + "You begin to shake a tree, and notice a coconut begin to fall from the air. +As you try to get your hand up to block it, you feel the impact as it lands +on your head.") + (erbp-die "a coconut")) + (if (= objnum obj-bear) + (progn + (erbp-mprinc +"As you go up to the bear, it removes your head and places it on the ground.") + (erbp-die "a bear")) + (if (< objnum 0) + (erbp-mprincl "You cannot shake that.") + (erbp-mprincl "You don't have that."))))))))) + + +(defun erbp-drop (obj) + (if erbp-inbus + (erbp-mprincl "You can't drop anything while on the bus.") + (let (objnum ptr) + (when (setq objnum (erbp-objnum-from-args-std obj)) + (if (not (setq ptr (member objnum erbp-inventory))) + (erbp-mprincl "You don't have that.") + (progn + (erbp-remove-obj-from-inven objnum) + (erbp-replace erbp-room-objects erbp-current-room + (append (nth erbp-current-room erbp-room-objects) + (list objnum))) + (erbp-mprincl "Done.") + (if (member objnum (list obj-food obj-weight obj-jar)) + (erbp-drop-check objnum)))))))) + +;;; Dropping certain things causes things to happen. + +(defun erbp-drop-check (objnum) + (if (and (= objnum obj-food) (= erbp-room bear-hangout) + (member obj-bear (nth bear-hangout erbp-room-objects))) + (progn + (erbp-mprincl +"The bear takes the food and runs away with it. He left something behind.") + (erbp-remove-obj-from-room erbp-current-room obj-bear) + (erbp-remove-obj-from-room erbp-current-room obj-food) + (erbp-replace erbp-room-objects erbp-current-room + (append (nth erbp-current-room erbp-room-objects) + (list obj-key))))) + + (if (and (= objnum obj-jar) (member obj-nitric erbp-jar) + (member obj-glycerine erbp-jar)) + (progn + (erbp-mprincl + "As the jar impacts the ground it explodes into many pieces.") + (setq erbp-jar nil) + (erbp-remove-obj-from-room erbp-current-room obj-jar) + (if (= erbp-current-room fourth-vermont-intersection) + (progn + (setq erbp-hole t) + (setq erbp-current-room vermont-station) + (erbp-mprincl +"The explosion causes a hole to open up in the ground, which you fall +through."))))) + + (if (and (= objnum obj-weight) (= erbp-current-room maze-button-room)) + (erbp-mprincl "A passageway opens."))) + +;;; Give long description of current erbp-room, or an object. + +(defun erbp-examine (obj) + (let (objnum) + (setq objnum (erbp-objnum-from-args obj)) + (if (eq objnum obj-special) + (erbp-describe-room (* erbp-current-room -1)) + (if (and (eq objnum obj-computer) + (member obj-pc (nth erbp-current-room erbp-room-silents))) + (erbp-examine '("pc")) + (if (eq objnum nil) + (erbp-mprincl "I don't know what that is.") + (if (and (not (member objnum + (nth erbp-current-room erbp-room-objects))) + (not (and (member obj-jar erbp-inventory) + (member objnum erbp-jar))) + (not (member objnum + (nth erbp-current-room erbp-room-silents))) + (not (member objnum erbp-inventory))) + (erbp-mprincl "I don't see that here.") + (if (>= objnum 0) + (if (and (= objnum obj-bone) + (= erbp-current-room marine-life-area) erbp-black) + (erbp-mprincl +"In this light you can see some writing on the bone. It says: +For an explosive time, go to Fourth St. and Vermont.") + (if (nth objnum erbp-physobj-desc) + (erbp-mprincl (nth objnum erbp-physobj-desc)) + (erbp-mprincl "I see nothing special about that."))) + (if (nth (abs objnum) erbp-permobj-desc) + (progn + (erbp-mprincl (nth (abs objnum) erbp-permobj-desc))) + (erbp-mprincl "I see nothing special about that."))))))))) + +(defun erbp-take (obj) + (setq obj (erbp-firstword obj)) + (if (not obj) + (erbp-mprincl "You must supply an object.") + (if (string= obj "all") + (let (gotsome) + (if erbp-inbus + (erbp-mprincl "You can't take anything while on the bus.") + (setq gotsome nil) + (dolist (x (nth erbp-current-room erbp-room-objects)) + (if (and (>= x 0) (not (= x obj-special))) + (progn + (setq gotsome t) + (erbp-mprinc (cadr (nth x erbp-objects))) + (erbp-mprinc ": ") + (erbp-take-object x)))) + (if (not gotsome) + (erbp-mprincl "Nothing to take.")))) + (let (objnum) + (setq objnum (cdr (assq (intern obj) erbp-objnames))) + (if (eq objnum nil) + (progn + (erbp-mprinc "I don't know what that is.") + (erbp-mprinc "\n")) + (if (and erbp-inbus (not (and (member objnum erbp-jar) + (member obj-jar erbp-inventory)))) + (erbp-mprincl "You can't take anything while on the bus.") + (erbp-take-object objnum))))))) + +(defun erbp-take-object (objnum) + (if (and (member objnum erbp-jar) (member obj-jar erbp-inventory)) + (let (newjar) + (erbp-mprincl "You remove it from the jar.") + (setq newjar nil) + (dolist (x erbp-jar) + (if (not (= x objnum)) + (setq newjar (append newjar (list x))))) + (setq erbp-jar newjar) + (setq erbp-inventory (append erbp-inventory (list objnum)))) + (if (not (member objnum (nth erbp-current-room erbp-room-objects))) + (if (not (member objnum (nth erbp-current-room erbp-room-silents))) + (erbp-mprinc "I do not see that here.") + (erbp-try-take objnum)) + (if (>= objnum 0) + (progn + (if (and (car erbp-inventory) + (> (+ (erbp-inven-weight) (nth objnum erbp-object-lbs)) 11)) + (erbp-mprinc "Your load would be too heavy.") + (setq erbp-inventory (append erbp-inventory (list objnum))) + (erbp-remove-obj-from-room erbp-current-room objnum) + (erbp-mprinc "Taken. ") + (if (and (= objnum obj-towel) (= erbp-current-room red-room)) + (erbp-mprinc + "Taking the towel reveals a hole in the floor.")))) + (erbp-try-take objnum))) + (erbp-mprinc "\n"))) + +(defun erbp-inven-weight () + (let (total) + (setq total 0) + (dolist (x erbp-jar) + (setq total (+ total (nth x erbp-object-lbs)))) + (dolist (x erbp-inventory) + (setq total (+ total (nth x erbp-object-lbs)))) total)) + +;;; We try to take an object that is untakable. Print a message +;;; depending on what it is. + +(defun erbp-try-take (obj) + (erbp-mprinc "You cannot take that.")) + +(defun erbp-dig (args) + (if erbp-inbus + (erbp-mprincl "Digging here reveals nothing.") + (if (not (member 0 erbp-inventory)) + (erbp-mprincl "You have nothing with which to dig.") + (if (not (nth erbp-current-room erbp-diggables)) + (erbp-mprincl "Digging here reveals nothing.") + (erbp-mprincl "I think you found something.") + (erbp-replace erbp-room-objects erbp-current-room + (append (nth erbp-current-room erbp-room-objects) + (nth erbp-current-room erbp-diggables))) + (erbp-replace erbp-diggables erbp-current-room nil))))) + +(defun erbp-climb (obj) + (let (objnum) + (setq objnum (erbp-objnum-from-args obj)) + (cond ((not objnum) + (erbp-mprincl "I don't know what that object is.")) + ((and (not (eq objnum obj-special)) + (not (member objnum (nth erbp-current-room erbp-room-objects))) + (not (member objnum (nth erbp-current-room erbp-room-silents))) + (not (and (member objnum erbp-jar) (member obj-jar erbp-inventory))) + (not (member objnum erbp-inventory))) + (erbp-mprincl "I don't see that here.")) + ((and (eq objnum obj-special) + (not (member obj-tree (nth erbp-current-room erbp-room-silents)))) + (erbp-mprincl "There is nothing here to climb.")) + ((and (not (eq objnum obj-tree)) (not (eq objnum obj-special))) + (erbp-mprincl "You can't climb that.")) + (t + (erbp-mprincl + "You manage to get about two feet up the tree and fall back down. You +notice that the tree is very unsteady."))))) + +(defun erbp-eat (obj) + (let (objnum) + (when (setq objnum (erbp-objnum-from-args-std obj)) + (if (not (member objnum erbp-inventory)) + (erbp-mprincl "You don't have that.") + (if (not (= objnum obj-food)) + (progn + (erbp-mprinc "You forcefully shove ") + (erbp-mprinc (downcase (cadr (nth objnum erbp-objects)))) + (erbp-mprincl " down your throat, and start choking.") + (erbp-die "choking")) + (erbp-mprincl "That tasted horrible.") + (erbp-remove-obj-from-inven obj-food)))))) + +(defun erbp-put (args) + (let (newargs objnum objnum2 obj) + (setq newargs (erbp-firstwordl args)) + (if (not newargs) + (erbp-mprincl "You must supply an object") + (setq obj (intern (car newargs))) + (setq objnum (cdr (assq obj erbp-objnames))) + (if (not objnum) + (erbp-mprincl "I don't know what that object is.") + (if (not (member objnum erbp-inventory)) + (erbp-mprincl "You don't have that.") + (setq newargs (erbp-firstwordl (cdr newargs))) + (setq newargs (erbp-firstwordl (cdr newargs))) + (if (not newargs) + (erbp-mprincl "You must supply an indirect object.") + (setq objnum2 (cdr (assq (intern (car newargs)) erbp-objnames))) + (if (and (eq objnum2 obj-computer) (= erbp-current-room pc-area)) + (setq objnum2 obj-pc)) + (if (not objnum2) + (erbp-mprincl "I don't know what that indirect object is.") + (if (and (not (member objnum2 + (nth erbp-current-room erbp-room-objects))) + (not (member objnum2 + (nth erbp-current-room erbp-room-silents))) + (not (member objnum2 erbp-inventory))) + (erbp-mprincl "That indirect object is not here.") + (erbp-put-objs objnum objnum2))))))))) + +(defun erbp-put-objs (obj1 obj2) + (if (and (= obj2 obj-drop) (not erbp-nomail)) + (setq obj2 obj-chute)) + + (if (= obj2 obj-disposal) (setq obj2 obj-chute)) + + (if (and (= obj1 obj-cpu) (= obj2 obj-computer)) + (progn + (erbp-remove-obj-from-inven obj-cpu) + (setq erbp-computer t) + (erbp-mprincl +"As you put the CPU board in the computer, it immediately springs to life. +The lights start flashing, and the fans seem to startup.")) + (if (and (= obj1 obj-weight) (= obj2 obj-button)) + (erbp-drop '("weight")) + (if (= obj2 obj-jar) ;; Put something in jar + (if (not (member obj1 (list obj-paper obj-diamond obj-emerald + obj-license obj-coins obj-egg + obj-nitric obj-glycerine))) + (erbp-mprincl "That will not fit in the jar.") + (erbp-remove-obj-from-inven obj1) + (setq erbp-jar (append erbp-jar (list obj1))) + (erbp-mprincl "Done.")) + (if (= obj2 obj-chute) ;; Put something in chute + (progn + (erbp-remove-obj-from-inven obj1) + (erbp-mprincl +"You hear it slide down the chute and off into the distance.") + (erbp-put-objs-in-treas (list obj1))) + (if (= obj2 obj-box) ;; Put key in key box + (if (= obj1 obj-key) + (progn + (erbp-mprincl +"As you drop the key, the box begins to shake. Finally it explodes +with a bang. The key seems to have vanished!") + (erbp-remove-obj-from-inven obj1) + (erbp-replace erbp-room-objects computer-room (append + (nth computer-room + erbp-room-objects) + (list obj1))) + (erbp-remove-obj-from-room erbp-current-room obj-box) + (setq erbp-key-level (1+ erbp-key-level))) + (erbp-mprincl "You can't put that in the key box!")) + + (if (and (= obj1 obj-floppy) (= obj2 obj-pc)) + (progn + (setq erbp-floppy t) + (erbp-remove-obj-from-inven obj1) + (erbp-mprincl "Done.")) + + (if (= obj2 obj-urinal) ;; Put object in urinal + (progn + (erbp-remove-obj-from-inven obj1) + (erbp-replace erbp-room-objects urinal (append + (nth urinal erbp-room-objects) + (list obj1))) + (erbp-mprincl + "You hear it plop down in some water below.")) + (if (= obj2 obj-mail) + (erbp-mprincl "The mail chute is locked.") + (if (member obj1 erbp-inventory) + (erbp-mprincl +"I don't know how to combine those objects. Perhaps you should +just try dropping it.") + (erbp-mprincl"You can't put that there."))))))))))) + +(defun erbp-type (args) + (if (not (= erbp-current-room computer-room)) + (erbp-mprincl "There is nothing here on which you could type.") + (if (not erbp-computer) + (erbp-mprincl +"You type on the keyboard, but your characters do not even echo.") + (erbp-unix-interface)))) + +;;; Various movement directions + +(defun erbp-n (args) + (erbp-move north)) + +(defun erbp-s (args) + (erbp-move south)) + +(defun erbp-e (args) + (erbp-move east)) + +(defun erbp-w (args) + (erbp-move west)) + +(defun erbp-ne (args) + (erbp-move northeast)) + +(defun erbp-se (args) + (erbp-move southeast)) + +(defun erbp-nw (args) + (erbp-move northwest)) + +(defun erbp-sw (args) + (erbp-move southwest)) + +(defun erbp-up (args) + (erbp-move up)) + +(defun erbp-down (args) + (erbp-move down)) + +(defun erbp-in (args) + (erbp-move in)) + +(defun erbp-out (args) + (erbp-move out)) + +(defun erbp-go (args) + (if (or (not (car args)) + (eq (erbp-doverb erbp-ignore erbp-verblist (car args) + (cdr (cdr args))) -1)) + (erbp-mprinc "I don't understand where you want me to go.\n"))) + +;;; Uses the erbpeon-map to figure out where we are going. If the +;;; requested direction yields 255, we know something special is +;;; supposed to happen, or perhaps you can't go that way unless +;;; certain conditions are met. + +(defun erbp-move (dir) + (if (and (not (member erbp-current-room erbp-light-rooms)) + (not (member obj-lamp erbp-inventory))) + (progn + (erbp-mprinc +"You trip over a grue and fall into a pit and break every bone in your +body.") + (erbp-die "a grue")) + (let (newroom) + (setq newroom (nth dir (nth erbp-current-room erbpeon-map))) + (if (eq newroom -1) + (erbp-mprinc "You can't go that way.\n") + (if (eq newroom 255) + (erbp-special-move dir) + (setq erbp-room -1) + (setq erbp-lastdir dir) + (if erbp-inbus + (progn + (if (or (< newroom 58) (> newroom 83)) + (erbp-mprincl "The bus cannot go this way.") + (erbp-mprincl + "The bus lurches ahead and comes to a screeching halt.") + (erbp-remove-obj-from-room erbp-current-room obj-bus) + (setq erbp-current-room newroom) + (erbp-replace erbp-room-objects newroom + (append (nth newroom erbp-room-objects) + (list obj-bus))))) + (setq erbp-current-room newroom))))))) + +;;; Movement in this direction causes something special to happen if the +;;; right conditions exist. It may be that you can't go this way unless +;;; you have a key, or a passage has been opened. + +;;; coding note: Each check of the current room is on the same 'if' level, +;;; i.e. there aren't else's. If two rooms next to each other have +;;; specials, and they are connected by specials, this could cause +;;; a problem. Be careful when adding them to consider this, and +;;; perhaps use else's. + +(defun erbp-special-move (dir) + (if (= erbp-current-room building-front) + (if (not (member obj-key erbp-inventory)) + (erbp-mprincl "You don't have a key that can open this door.") + (setq erbp-current-room old-building-hallway)) + (if (= erbp-current-room north-end-of-cave-passage) + (let (combo) + (erbp-mprincl +"You must type a 3 digit combination code to enter this room.") + (erbp-mprinc "Enter it here: ") + (setq combo (erbp-read-line)) + (if (not erbp-batch-mode) + (erbp-mprinc "\n")) + (if (string= combo erbp-combination) + (setq erbp-current-room gamma-computing-center) + (erbp-mprincl "Sorry, that combination is incorrect.")))) + + (if (= erbp-current-room bear-hangout) + (if (member obj-bear (nth bear-hangout erbp-room-objects)) + (progn + (erbp-mprinc +"The bear is very annoyed that you would be so presumptuous as to try +and walk right by it. He tells you so by tearing your head off. +") + (erbp-die "a bear")) + (erbp-mprincl "You can't go that way."))) + + (if (= erbp-current-room vermont-station) + (progn + (erbp-mprincl +"As you board the train it immediately leaves the station. It is a very +bumpy ride. It is shaking from side to side, and up and down. You +sit down in one of the chairs in order to be more comfortable.") + (erbp-mprincl +"\nFinally the train comes to a sudden stop, and the doors open, and some +force throws you out. The train speeds away.\n") + (setq erbp-current-room museum-station))) + + (if (= erbp-current-room old-building-hallway) + (if (and (member obj-key erbp-inventory) + (> erbp-key-level 0)) + (setq erbp-current-room meadow) + (erbp-mprincl "You don't have a key that can open this door."))) + + (if (and (= erbp-current-room maze-button-room) (= dir northwest)) + (if (member obj-weight (nth maze-button-room erbp-room-objects)) + (setq erbp-current-room 18) + (erbp-mprincl "You can't go that way."))) + + (if (and (= erbp-current-room maze-button-room) (= dir up)) + (if (member obj-weight (nth maze-button-room erbp-room-objects)) + (erbp-mprincl "You can't go that way.") + (setq erbp-current-room weight-room))) + + (if (= erbp-current-room classroom) + (erbp-mprincl "The door is locked.")) + + (if (or (= erbp-current-room lakefront-north) + (= erbp-current-room lakefront-south)) + (erbp-swim nil)) + + (if (= erbp-current-room reception-area) + (if (not (= erbp-sauna-level 3)) + (setq erbp-current-room health-club-front) + (erbp-mprincl +"As you exit the building, you notice some flames coming out of one of the +windows. Suddenly, the building explodes in a huge ball of fire. The flames +engulf you, and you burn to death.") + (erbp-die "burning"))) + + (if (= erbp-current-room red-room) + (if (not (member obj-towel (nth red-room erbp-room-objects))) + (setq erbp-current-room long-n-s-hallway) + (erbp-mprincl "You can't go that way."))) + + (if (and (> dir down) (> erbp-current-room gamma-computing-center) + (< erbp-current-room museum-lobby)) + (if (not (member obj-bus (nth erbp-current-room erbp-room-objects))) + (erbp-mprincl "You can't go that way.") + (if (= dir in) + (if erbp-inbus + (erbp-mprincl + "You are already in the bus!") + (if (member obj-license erbp-inventory) + (progn + (erbp-mprincl + "You board the bus and get in the driver's seat.") + (setq erbp-nomail t) + (setq erbp-inbus t)) + (erbp-mprincl "You are not licensed for this type of vehicle."))) + (if (not erbp-inbus) + (erbp-mprincl "You are already off the bus!") + (erbp-mprincl "You hop off the bus.") + (setq erbp-inbus nil)))) + (if (= erbp-current-room fifth-oaktree-intersection) + (if (not erbp-inbus) + (progn + (erbp-mprincl "You fall down the cliff and land on your head.") + (erbp-die "a cliff")) + (erbp-mprincl +"The bus flies off the cliff, and plunges to the bottom, where it explodes.") + (erbp-die "a bus accident"))) + (if (= erbp-current-room main-maple-intersection) + (progn + (if (not erbp-inbus) + (erbp-mprincl "The gate will not open.") + (erbp-mprincl +"As the bus approaches, the gate opens and you drive through.") + (erbp-remove-obj-from-room main-maple-intersection obj-bus) + (erbp-replace erbp-room-objects museum-entrance + (append (nth museum-entrance erbp-room-objects) + (list obj-bus))) + (setq erbp-current-room museum-entrance))))) + (if (= erbp-current-room cave-entrance) + (progn + (erbp-mprincl +"As you enter the room you hear a rumbling noise. You look back to see +huge rocks sliding down from the ceiling, and blocking your way out.\n") + (setq erbp-current-room misty-room))))) + +(defun erbp-long (args) + (setq erbp-mode "long")) + +(defun erbp-turn (obj) + (let (objnum direction) + (when (setq objnum (erbp-objnum-from-args-std obj)) + (if (not (or (member objnum (nth erbp-current-room erbp-room-objects)) + (member objnum (nth erbp-current-room erbp-room-silents)))) + (erbp-mprincl "I don't see that here.") + (if (not (= objnum obj-dial)) + (erbp-mprincl "You can't turn that.") + (setq direction (erbp-firstword (cdr obj))) + (if (or (not direction) + (not (or (string= direction "clockwise") + (string= direction "counterclockwise")))) + (erbp-mprincl "You must indicate clockwise or counterclockwise.") + (if (string= direction "clockwise") + (setq erbp-sauna-level (+ erbp-sauna-level 1)) + (setq erbp-sauna-level (- erbp-sauna-level 1))) + + (if (< erbp-sauna-level 0) + (progn + (erbp-mprincl + "The dial will not turn further in that direction.") + (setq erbp-sauna-level 0)) + (erbp-sauna-heat)))))))) + +(defun erbp-sauna-heat () + (if (= erbp-sauna-level 0) + (erbp-mprincl + "The temperature has returned to normal room temperature.")) + (if (= erbp-sauna-level 1) + (erbp-mprincl "It is now luke warm in here. You are perspiring.")) + (if (= erbp-sauna-level 2) + (erbp-mprincl "It is pretty hot in here. It is still very comfortable.")) + (if (= erbp-sauna-level 3) + (progn + (erbp-mprincl +"It is now very hot. There is something very refreshing about this.") + (if (or (member obj-rms erbp-inventory) + (member obj-rms (nth erbp-current-room erbp-room-objects))) + (progn + (erbp-mprincl +"You notice the wax on your statuette beginning to melt, until it completely +melts off. You are left with a beautiful diamond!") + (if (member obj-rms erbp-inventory) + (progn + (erbp-remove-obj-from-inven obj-rms) + (setq erbp-inventory (append erbp-inventory + (list obj-diamond)))) + (erbp-remove-obj-from-room erbp-current-room obj-rms) + (erbp-replace erbp-room-objects erbp-current-room + (append (nth erbp-current-room erbp-room-objects) + (list obj-diamond)))))) + (if (or (member obj-floppy erbp-inventory) + (member obj-floppy (nth erbp-current-room erbp-room-objects))) + (progn + (erbp-mprincl +"You notice your floppy disk beginning to melt. As you grab for it, the +disk bursts into flames, and disintegrates.") + (if (member obj-floppy erbp-inventory) + (erbp-remove-obj-from-inven obj-floppy) + (erbp-remove-obj-from-room erbp-current-room obj-floppy)))))) + + (if (= erbp-sauna-level 4) + (progn + (erbp-mprincl +"As the dial clicks into place, you immediately burst into flames.") + (erbp-die "burning")))) + +(defun erbp-press (obj) + (let (objnum) + (when (setq objnum (erbp-objnum-from-args-std obj)) + (if (not (or (member objnum (nth erbp-current-room erbp-room-objects)) + (member objnum (nth erbp-current-room erbp-room-silents)))) + (erbp-mprincl "I don't see that here.") + (if (not (member objnum (list obj-button obj-switch))) + (progn + (erbp-mprinc "You can't ") + (erbp-mprinc (car line-list)) + (erbp-mprincl " that.")) + (if (= objnum obj-button) + (erbp-mprincl +"As you press the button, you notice a passageway open up, but +as you release it, the passageway closes.")) + (if (= objnum obj-switch) + (if erbp-black + (progn + (erbp-mprincl "The button is now in the off position.") + (setq erbp-black nil)) + (erbp-mprincl "The button is now in the on position.") + (setq erbp-black t)))))))) + +(defun erbp-swim (args) + (if (not (member erbp-current-room (list lakefront-north lakefront-south))) + (erbp-mprincl "I see no water!") + (if (not (member obj-life erbp-inventory)) + (progn + (erbp-mprincl +"You dive in the water, and at first notice it is quite cold. You then +start to get used to it as you realize that you never really learned how +to swim.") + (erbp-die "drowning")) + (if (= erbp-current-room lakefront-north) + (setq erbp-current-room lakefront-south) + (setq erbp-current-room lakefront-north))))) + + +(defun erbp-score (args) + (if (not erbp-endgame) + (let (total) + (setq total (erbp-reg-score)) + (erbp-mprinc "You have scored ") + (erbp-mprinc total) + (erbp-mprincl " out of a possible 90 points.") total) + (erbp-mprinc "You have scored ") + (erbp-mprinc (erbp-endgame-score)) + (erbp-mprincl " endgame points out of a possible 110.") + (if (= (erbp-endgame-score) 110) + (erbp-mprincl +"\n\nCongratulations. You have won. The wizard password is 'moby'")))) + +(defun erbp-help (args) + (erbp-mprincl +"Welcome to erbpnet (2.01), by Ron Schnell (ronnie@driver-aces.com). +Here is some useful information (read carefully because there are one +or more clues in here): +- If you have a key that can open a door, you do not need to explicitly + open it. You may just use 'in' or walk in the direction of the door. + +- If you have a lamp, it is always lit. + +- You will not get any points until you manage to get treasures to a certain + place. Simply finding the treasures is not good enough. There is more + than one way to get a treasure to the special place. It is also + important that the objects get to the special place *unharmed* and + *untarnished*. You can tell if you have successfully transported the + object by looking at your score, as it changes immediately. Note that + an object can become harmed even after you have received points for it. + If this happens, your score will decrease, and in many cases you can never + get credit for it again. + +- You can save your game with the 'save' command, and use restore it + with the 'restore' command. + +- There are no limits on lengths of object names. + +- Directions are: north,south,east,west,northeast,southeast,northwest, + southwest,up,down,in,out. + +- These can be abbreviated: n,s,e,w,ne,se,nw,sw,u,d,in,out. + +- If you go down a hole in the floor without an aid such as a ladder, + you probably won't be able to get back up the way you came, if at all. + +- To run this game in batch mode (no emacs window), use: + emacs -batch -l erbpnet +NOTE: This game *should* be run in batch mode! + +If you have questions or comments, please contact ronnie@driver-aces.com +My home page is http://www.driver-aces.com/ronnie.html +")) + +(defun erbp-flush (args) + (if (not (= erbp-current-room bathroom)) + (erbp-mprincl "I see nothing to flush.") + (erbp-mprincl "Whoooosh!!") + (erbp-put-objs-in-treas (nth urinal erbp-room-objects)) + (erbp-replace erbp-room-objects urinal nil))) + +(defun erbp-piss (args) + (if (not (= erbp-current-room bathroom)) + (erbp-mprincl "You can't do that here, don't even bother trying.") + (if (not erbp-gottago) + (erbp-mprincl "I'm afraid you don't have to go now.") + (erbp-mprincl "That was refreshing.") + (setq erbp-gottago nil) + (erbp-replace erbp-room-objects urinal (append + (nth urinal erbp-room-objects) + (list obj-URINE)))))) + + +(defun erbp-sleep (args) + (if (not (= erbp-current-room bedroom)) + (erbp-mprincl +"You try to go to sleep while standing up here, but can't seem to do it.") + (setq erbp-gottago t) + (erbp-mprincl +"As soon as you start to doze off you begin dreaming. You see images of +workers digging caves, slaving in the humid heat. Then you see yourself +as one of these workers. While no one is looking, you leave the group +and walk into a room. The room is bare except for a horseshoe +shaped piece of stone in the center. You see yourself digging a hole in +the ground, then putting some kind of treasure in it, and filling the hole +with dirt again. After this, you immediately wake up."))) + +(defun erbp-break (obj) + (let (objnum) + (if (not (member obj-axe erbp-inventory)) + (erbp-mprincl "You have nothing you can use to break things.") + (when (setq objnum (erbp-objnum-from-args-std obj)) + (if (member objnum erbp-inventory) + (progn + (erbp-mprincl +"You take the object in your hands and swing the axe. Unfortunately, you miss +the object and slice off your hand. You bleed to death.") + (erbp-die "an axe")) + (if (not (or (member objnum (nth erbp-current-room erbp-room-objects)) + (member objnum + (nth erbp-current-room erbp-room-silents)))) + (erbp-mprincl "I don't see that here.") + (if (= objnum obj-cable) + (progn + (erbp-mprincl +"As you break the ethernet cable, everything starts to blur. You collapse +for a moment, then straighten yourself up. +") + (erbp-replace erbp-room-objects gamma-computing-center + (append + (nth gamma-computing-center erbp-room-objects) + erbp-inventory)) + (if (member obj-key erbp-inventory) + (progn + (setq erbp-inventory (list obj-key)) + (erbp-remove-obj-from-room + gamma-computing-center obj-key)) + (setq erbp-inventory nil)) + (setq erbp-current-room computer-room) + (setq erbp-ethernet nil) + (erbp-mprincl "Connection closed.") + (erbp-unix-interface)) + (if (< objnum 0) + (progn + (erbp-mprincl "Your axe shatters into a million pieces.") + (erbp-remove-obj-from-inven obj-axe)) + (erbp-mprincl "Your axe breaks it into a million pieces.") + (erbp-remove-obj-from-room erbp-current-room objnum))))))))) + +(defun erbp-drive (args) + (if (not erbp-inbus) + (erbp-mprincl "You cannot drive when you aren't in a vehicle.") + (erbp-mprincl "To drive while you are in the bus, just give a direction."))) + +(defun erbp-superb (args) + (setq erbp-mode 'erbp-superb)) + +(defun erbp-reg-score () + (let (total) + (setq total 0) + (dolist (x (nth treasure-room erbp-room-objects)) + (setq total (+ total (nth x erbp-object-pts)))) + (if (member obj-URINE (nth treasure-room erbp-room-objects)) + (setq total 0)) total)) + +(defun erbp-endgame-score () + (let (total) + (setq total 0) + (dolist (x (nth endgame-treasure-room erbp-room-objects)) + (setq total (+ total (nth x erbp-object-pts)))) total)) + +(defun erbp-answer (args) + (if (not erbp-correct-answer) + (erbp-mprincl "I don't believe anyone asked you anything.") + (setq args (car args)) + (if (not args) + (erbp-mprincl "You must give the answer on the same line.") + (if (erbp-members args erbp-correct-answer) + (progn + (erbp-mprincl "Correct.") + (if (= erbp-lastdir 0) + (setq erbp-current-room (1+ erbp-current-room)) + (setq erbp-current-room (- erbp-current-room 1))) + (setq erbp-correct-answer nil)) + (erbp-mprincl "That answer is incorrect."))))) + +(defun erbp-endgame-question () +(if (not erbp-endgame-questions) + (progn + (erbp-mprincl "Your question is:") + (erbp-mprincl "No more questions, just do 'answer foo'.") + (setq erbp-correct-answer '("foo"))) + (let (which i newques) + (setq i 0) + (setq newques nil) + (setq which (random (length erbp-endgame-questions))) + (erbp-mprincl "Your question is:") + (erbp-mprincl (setq erbp-endgame-question (car + (nth which + erbp-endgame-questions)))) + (setq erbp-correct-answer (cdr (nth which erbp-endgame-questions))) + (while (< i which) + (setq newques (append newques (list (nth i erbp-endgame-questions)))) + (setq i (1+ i))) + (setq i (1+ which)) + (while (< i (length erbp-endgame-questions)) + (setq newques (append newques (list (nth i erbp-endgame-questions)))) + (setq i (1+ i))) + (setq erbp-endgame-questions newques)))) + +(defun erbp-power (args) + (if (not (= erbp-current-room pc-area)) + (erbp-mprincl "That operation is not applicable here.") + (if (not erbp-floppy) + (erbp-dos-no-disk) + (erbp-dos-interface)))) + +(defun erbp-feed (args) + (let (objnum) + (when (setq objnum (erbp-objnum-from-args-std args)) + (if (and (= objnum obj-bear) + (member obj-bear (nth erbp-current-room erbp-room-objects))) + (progn + (if (not (member obj-food erbp-inventory)) + (erbp-mprincl "You have nothing with which to feed it.") + (erbp-drop '("food")))) + (if (not (or (member objnum (nth erbp-current-room erbp-room-objects)) + (member objnum erbp-inventory) + (member objnum (nth erbp-current-room erbp-room-silents)))) + (erbp-mprincl "I don't see that here.") + (erbp-mprincl "You cannot feed that.")))))) + + +;;;; +;;;; This section defines various utility functions used +;;;; by erbpnet. +;;;; + + +;;; Function which takes a verb and a list of other words. Calls proper +;;; function associated with the verb, and passes along the other words. + +(defun erbp-doverb (erbp-ignore erbp-verblist verb rest) + (if (not verb) + nil + (if (member (intern verb) erbp-ignore) + (if (not (car rest)) -1 + (erbp-doverb erbp-ignore erbp-verblist (car rest) (cdr rest))) + (if (not (cdr (assq (intern verb) erbp-verblist))) -1 + (setq erbp-numcmds (1+ erbp-numcmds)) + (eval (list (cdr (assq (intern verb) erbp-verblist)) (quote rest))))))) + + +;;; Function to take a string and change it into a list of lowercase words. + +(defun erbp-listify-string (strin) + (let (pos ret-list end-pos) + (setq pos 0) + (setq ret-list nil) + (while (setq end-pos (string-match "[ ,:;]" (substring strin pos))) + (setq end-pos (+ end-pos pos)) + (if (not (= end-pos pos)) + (setq ret-list (append ret-list (list + (downcase + (substring strin pos end-pos)))))) + (setq pos (+ end-pos 1))) ret-list)) + +(defun erbp-listify-string2 (strin) + (let (pos ret-list end-pos) + (setq pos 0) + (setq ret-list nil) + (while (setq end-pos (string-match " " (substring strin pos))) + (setq end-pos (+ end-pos pos)) + (if (not (= end-pos pos)) + (setq ret-list (append ret-list (list + (downcase + (substring strin pos end-pos)))))) + (setq pos (+ end-pos 1))) ret-list)) + +(defun erbp-replace (list n number) + (rplaca (nthcdr n list) number)) + + +;;; Get the first non-ignored word from a list. + +(defun erbp-firstword (list) + (if (not (car list)) + nil + (while (and list (member (intern (car list)) erbp-ignore)) + (setq list (cdr list))) + (car list))) + +(defun erbp-firstwordl (list) + (if (not (car list)) + nil + (while (and list (member (intern (car list)) erbp-ignore)) + (setq list (cdr list))) + list)) + +;;; parse a line passed in as a string Call the proper verb with the +;;; rest of the line passed in as a list. + +(defun erbp-vparse (erbp-ignore erbp-verblist line) + (erbp-mprinc "\n") + (setq line-list (erbp-listify-string (concat line " "))) + (erbp-doverb erbp-ignore erbp-verblist (car line-list) (cdr line-list))) + +(defun erbp-parse2 (erbp-ignore erbp-verblist line) + (erbp-mprinc "\n") + (setq line-list (erbp-listify-string2 (concat line " "))) + (erbp-doverb erbp-ignore erbp-verblist (car line-list) (cdr line-list))) + +;;; Read a line, in window mode + +(defun erbp-read-line () + (let (line) + (setq line (read-string "")) + (erbp-mprinc line) line)) + +;;; Insert something into the window buffer + +(defun erbp-minsert (string) + (if (stringp string) + (insert string) + (insert (prin1-to-string string)))) + +;;; Print something out, in window mode + +(defun erbp-mprinc (string) + (if (stringp string) + (insert string) + (insert (prin1-to-string string)))) + +;;; In window mode, keep screen from jumping by keeping last line at +;;; the bottom of the screen. + +(defun erbp-fix-screen () + (interactive) + (forward-line (- 0 (- (window-height) 2 ))) + (set-window-start (selected-window) (point)) + (end-of-buffer)) + +;;; Insert something into the buffer, followed by newline. + +(defun erbp-minsertl (string) + (erbp-minsert string) + (erbp-minsert "\n")) + +;;; Print something, followed by a newline. + +(defun erbp-mprincl (string) + (erbp-mprinc string) + (erbp-mprinc "\n")) + +;;; Function which will get an object number given the list of +;;; words in the command, except for the verb. + +(defun erbp-objnum-from-args (obj) + (let (objnum) + (setq obj (erbp-firstword obj)) + (if (not obj) + obj-special + (setq objnum (cdr (assq (intern obj) erbp-objnames)))))) + +(defun erbp-objnum-from-args-std (obj) + (let (result) + (if (eq (setq result (erbp-objnum-from-args obj)) obj-special) + (erbp-mprincl "You must supply an object.")) + (if (eq result nil) + (erbp-mprincl "I don't know what that is.")) + (if (eq result obj-special) + nil + result))) + +;;; Take a short room description, and change spaces and slashes to dashes. + +(defun erbp-space-to-hyphen (string) + (let (space) + (if (setq space (string-match "[ /]" string)) + (progn + (setq string (concat (substring string 0 space) "-" + (substring string (1+ space)))) + (erbp-space-to-hyphen string)) + string))) + +;;; Given a unix style pathname, build a list of path components (recursive) + +(defun erbp-get-path (dirstring startlist) + (let (slash pos) + (if (= (length dirstring) 0) + startlist + (if (string= (substring dirstring 0 1) "/") + (erbp-get-path (substring dirstring 1) (append startlist (list "/"))) + (if (not (setq slash (string-match "/" dirstring))) + (append startlist (list dirstring)) + (erbp-get-path (substring dirstring (1+ slash)) + (append startlist + (list (substring dirstring 0 slash))))))))) + + +;;; Is a string a member of a string list? + +(defun erbp-members (string string-list) + (let (found) + (setq found nil) + (dolist (x string-list) + (if (string= x string) + (setq found t))) found)) + +;;; Function to put objects in the treasure room. Also prints current +;;; score to let user know he has scored. + +(defun erbp-put-objs-in-treas (objlist) + (let (oscore newscore) + (setq oscore (erbp-reg-score)) + (erbp-replace erbp-room-objects 0 (append (nth 0 erbp-room-objects) objlist)) + (setq newscore (erbp-reg-score)) + (if (not (= oscore newscore)) + (erbp-score nil)))) + +;;; Load an encrypted file, and eval it. + +(defun erbp-load-d (filename) + (let (old-buffer result) + (setq result t) + (setq old-buffer (current-buffer)) + (switch-to-buffer (get-buffer-create "*loadc*")) + (erase-buffer) + (condition-case nil + (insert-file-contents filename) + (error (setq result nil))) + (unless (not result) + (condition-case nil + (erbp-rot13) + (error (yank))) + (eval-current-buffer) + (kill-buffer (current-buffer))) + (switch-to-buffer old-buffer) + result)) + +;;; Functions to remove an object either from a room, or from inventory. + +(defun erbp-remove-obj-from-room (erbp-room objnum) + (let (newroom) + (setq newroom nil) + (dolist (x (nth erbp-room erbp-room-objects)) + (if (not (= x objnum)) + (setq newroom (append newroom (list x))))) + (rplaca (nthcdr erbp-room erbp-room-objects) newroom))) + +(defun erbp-remove-obj-from-inven (objnum) + (let (new-inven) + (setq new-inven nil) + (dolist (x erbp-inventory) + (if (not (= x objnum)) + (setq new-inven (append new-inven (list x))))) + (setq erbp-inventory new-inven))) + + +(let ((i 0) (lower "abcdefghijklmnopqrstuvwxyz") upper) + (setq erbp-translate-table (make-vector 256 0)) + (while (< i 256) + (aset erbp-translate-table i i) + (setq i (1+ i))) + (setq lower (concat lower lower)) + (setq upper (upcase lower)) + (setq i 0) + (while (< i 26) + (aset erbp-translate-table (+ ?a i) (aref lower (+ i 13))) + (aset erbp-translate-table (+ ?A i) (aref upper (+ i 13))) + (setq i (1+ i)))) + +(defun erbp-rot13 () + (let (str len (i 0)) + (setq str (buffer-substring (point-min) (point-max))) + (setq len (length str)) + (while (< i len) + (aset str i (aref erbp-translate-table (aref str i))) + (setq i (1+ i))) + (erase-buffer) + (insert str))) + +;;;; +;;;; This section defines the globals that are used in erbpnet. +;;;; +;;;; IMPORTANT +;;;; All globals which can change must be saved from 'save-game. Add +;;;; all new globals to bottom of file. + +(setq erbp-visited '(27)) +(setq erbp-current-room 1) +(setq erbp-exitf nil) +(setq erbp-badcd nil) +(defvar erbpeon-mode-map nil) +(setq erbpeon-mode-map (make-sparse-keymap)) +(define-key erbpeon-mode-map "\r" 'erbp-parse) +(defvar erbpeon-batch-map (make-keymap)) +(if (string= (substring emacs-version 0 2) "18") + (let (n) + (setq n 32) + (while (< 0 (setq n (- n 1))) + (aset erbpeon-batch-map n 'erbpeon-nil))) + (let (n) + (setq n 32) + (while (< 0 (setq n (- n 1))) + (aset (car (cdr erbpeon-batch-map)) n 'erbpeon-nil)))) +(define-key erbpeon-batch-map "\r" 'exit-minibuffer) +(define-key erbpeon-batch-map "\n" 'exit-minibuffer) +(setq erbp-computer nil) +(setq erbp-floppy nil) +(setq erbp-key-level 0) +(setq erbp-hole nil) +(setq erbp-correct-answer nil) +(setq erbp-lastdir 0) +(setq erbp-numsaves 0) +(setq erbp-jar nil) +(setq erbp-dead nil) +(setq room 0) +(setq erbp-numcmds 0) +(setq erbp-wizard nil) +(setq erbp-endgame-question nil) +(setq erbp-logged-in nil) +(setq erbpeon-mode 'erbpeon) +(setq erbp-unix-verbs '((ls . erbp-ls) (ftp . erbp-ftp) (echo . erbp-echo) + (exit . erbp-uexit) (cd . erbp-cd) (pwd . erbp-pwd) + (rlogin . erbp-rlogin) (uncompress . erbp-uncompress) + (cat . erbp-cat) (zippy . erbp-zippy))) + +(setq erbp-dos-verbs '((dir . erbp-dos-dir) (type . erbp-dos-type) + (exit . erbp-dos-exit) (command . erbp-dos-spawn) + (b: . erbp-dos-invd) (c: . erbp-dos-invd) + (a: . erbp-dos-nil))) + + +(setq erbp-batch-mode nil) + +(setq erbp-cdpath "/usr/toukmond") +(setq erbp-cdroom -10) +(setq erbp-uncompressed nil) +(setq erbp-ethernet t) +(setq erbp-restricted + '(erbp-room-objects erbpeon-map erbp-rooms + erbp-room-silents erbp-combination)) +(setq erbp-ftptype 'ascii) +(setq erbp-endgame nil) +(setq erbp-gottago t) +(setq erbp-black nil) + +(setq erbp-rooms '( + ( +"You are in the treasure room. A door leads out to the north." + "Treasure room" + ) + ( +"You are at a dead end of a dirt road. The road goes to the east. +In the distance you can see that it will eventually fork off. The +trees here are very tall royal palms, and they are spaced equidistant +from each other." + "Dead end" + ) + ( +"You are on the continuation of a dirt road. There are more trees on +both sides of you. The road continues to the east and west." + "E/W Dirt road" + ) + ( +"You are at a fork of two passages, one to the northeast, and one to the +southeast. The ground here seems very soft. You can also go back west." + "Fork" + ) + ( +"You are on a northeast/southwest road." + "NE/SW road" + ) + ( +"You are at the end of the road. There is a building in front of you +to the northeast, and the road leads back to the southwest." + "Building front" + ) + ( +"You are on a southeast/northwest road." + "SE/NW road" + ) + ( +"You are standing at the end of a road. A passage leads back to the +northwest." + "Bear hangout" + ) + ( +"You are in the hallway of an old building. There are rooms to the east +and west, and doors leading out to the north and south." + "Old Building hallway" + ) + ( +"You are in a mailroom. There are many bins where the mail is usually +kept. The exit is to the west." + "Mailroom" + ) + ( +"You are in a computer room. It seems like most of the equipment has +been removed. There is a VAX 11/780 in front of you, however, with +one of the cabinets wide open. A sign on the front of the machine +says: This VAX is named 'pokey'. To type on the console, use the +'type' command. The exit is to the east." + "Computer room" + ) + ( +"You are in a meadow in the back of an old building. A small path leads +to the west, and a door leads to the south." + "Meadow" + ) + ( +"You are in a round, stone room with a door to the east. There +is a sign on the wall that reads: 'receiving room'." + "Receiving room" + ) + ( +"You are at the south end of a hallway that leads to the north. There +are rooms to the east and west." + "Northbound Hallway" + ) + ( +"You are in a sauna. There is nothing in the room except for a dial +on the wall. A door leads out to west." + "Sauna" + ) + ( +"You are at the end of a north/south hallway. You can go back to the south, +or off to a room to the east." + "End of N/S Hallway" + ) + ( +"You are in an old weight room. All of the equipment is either destroyed +or completely broken. There is a door out to the west, and there is a ladder +leading down a hole in the floor." + "Weight room" ;16 + ) + ( +"You are in a maze of twisty little passages, all alike. +There is a button on the ground here." + "Maze button room" + ) + ( +"You are in a maze of little twisty passages, all alike." + "Maze" + ) + ( +"You are in a maze of thirsty little passages, all alike." + "Maze" ;19 + ) + ( +"You are in a maze of twenty little passages, all alike." + "Maze" + ) + ( +"You are in a daze of twisty little passages, all alike." + "Maze" ;21 + ) + ( +"You are in a maze of twisty little cabbages, all alike." + "Maze" ;22 + ) + ( +"You are in a reception area for a health and fitness center. The place +appears to have been recently ransacked, and nothing is left. There is +a door out to the south, and a crawlspace to the southeast." + "Reception area" + ) + ( +"You are outside a large building to the north which used to be a health +and fitness center. A road leads to the south." + "Health Club front" + ) + ( +"You are at the north side of a lake. On the other side you can see +a road which leads to a cave. The water appears very deep." + "Lakefront North" + ) + ( +"You are at the south side of a lake. A road goes to the south." + "Lakefront South" + ) + ( +"You are in a well-hidden area off to the side of a road. Back to the +northeast through the brush you can see the bear hangout." + "Hidden area" + ) + ( +"The entrance to a cave is to the south. To the north, a road leads +towards a deep lake. On the ground nearby there is a chute, with a sign +that says 'put treasures here for points'." + "Cave Entrance" ;28 + ) + ( +"You are in a misty, humid room carved into a mountain. +To the north is the remains of a rockslide. To the east, a small +passage leads away into the darkness." ;29 + "Misty Room" + ) + ( +"You are in an east/west passageway. The walls here are made of +multicolored rock and are quite beautiful." + "Cave E/W passage" ;30 + ) + ( +"You are at the junction of two passages. One goes north/south, and +the other goes west." + "N/S/W Junction" ;31 + ) + ( +"You are at the north end of a north/south passageway. There are stairs +leading down from here. There is also a door leading west." + "North end of cave passage" ;32 + ) + ( +"You are at the south end of a north/south passageway. There is a hole +in the floor here, into which you could probably fit." + "South end of cave passage" ;33 + ) + ( +"You are in what appears to be a worker's bedroom. There is a queen- +sized bed in the middle of the room, and a painting hanging on the +wall. A door leads to another room to the south, and stairways +lead up and down." + "Bedroom" ;34 + ) + ( +"You are in a bathroom built for workers in the cave. There is a +urinal hanging on the wall, and some exposed pipes on the opposite +wall where a sink used to be. To the north is a bedroom." + "Bathroom" ;35 + ) + ( +"This is a marker for the urinal. User will not see this, but it +is a room that can contain objects." + "Urinal" ;36 + ) + ( +"You are at the northeast end of a northeast/southwest passageway. +Stairs lead up out of sight." + "NE end of NE/SW cave passage" ;37 + ) + ( +"You are at the junction of northeast/southwest and east/west passages." + "NE/SW-E/W junction" ;38 + ) + ( +"You are at the southwest end of a northeast/southwest passageway." + "SW end of NE/SW cave passage" ;39 + ) + ( +"You are at the east end of an E/W passage. There are stairs leading up +to a room above." + "East end of E/W cave passage" ;40 + ) + ( +"You are at the west end of an E/W passage. There is a hole on the ground +which leads down out of sight." + "West end of E/W cave passage" ;41 + ) + ( +"You are in a room which is bare, except for a horseshoe shaped boulder +in the center. Stairs lead down from here." ;42 + "Horseshoe boulder room" + ) + ( +"You are in a room which is completely empty. Doors lead out to the north +and east." + "Empty room" ;43 + ) + ( +"You are in an empty room. Interestingly enough, the stones in this +room are painted blue. Doors lead out to the east and south." ;44 + "Blue room" + ) + ( +"You are in an empty room. Interestingly enough, the stones in this +room are painted yellow. Doors lead out to the south and west." ;45 + "Yellow room" + ) + ( +"You are in an empty room. Interestingly enough, the stones in this room +are painted red. Doors lead out to the west and north." + "Red room" ;46 + ) + ( +"You are in the middle of a long north/south hallway." ;47 + "Long n/s hallway" + ) + ( +"You are 3/4 of the way towards the north end of a long north/south hallway." + "3/4 north" ;48 + ) + ( +"You are at the north end of a long north/south hallway. There are stairs +leading upwards." + "North end of long hallway" ;49 + ) + ( +"You are 3/4 of the way towards the south end of a long north/south hallway." + "3/4 south" ;50 + ) + ( +"You are at the south end of a long north/south hallway. There is a hole +to the south." + "South end of long hallway" ;51 + ) + ( +"You are at a landing in a stairwell which continues up and down." + "Stair landing" ;52 + ) + ( +"You are at the continuation of an up/down staircase." + "Up/down staircase" ;53 + ) + ( +"You are at the top of a staircase leading down. A crawlway leads off +to the northeast." + "Top of staircase." ;54 + ) + ( +"You are in a crawlway that leads northeast or southwest." + "NE crawlway" ;55 + ) + ( +"You are in a small crawlspace. There is a hole in the ground here, and +a small passage back to the southwest." + "Small crawlspace" ;56 + ) + ( +"You are in the Gamma Computing Center. An IBM 3090/600s is whirring +away in here. There is an ethernet cable coming out of one of the units, +and going through the ceiling. There is no console here on which you +could type." + "Gamma computing center" ;57 + ) + ( +"You are near the remains of a post office. There is a mail drop on the +face of the building, but you cannot see where it leads. A path leads +back to the east, and a road leads to the north." + "Post office" ;58 + ) + ( +"You are at the intersection of Main Street and Maple Ave. Main street +runs north and south, and Maple Ave runs east off into the distance. +If you look north and east you can see many intersections, but all of +the buildings that used to stand here are gone. Nothing remains except +street signs. +There is a road to the northwest leading to a gate that guards a building." + "Main-Maple intersection" ;59 + ) + ( +"You are at the intersection of Main Street and the west end of Oaktree Ave." + "Main-Oaktree intersection" ;60 + ) + ( +"You are at the intersection of Main Street and the west end of Vermont Ave." + "Main-Vermont intersection" ;61 + ) + ( +"You are at the north end of Main Street at the west end of Sycamore Ave." ;62 + "Main-Sycamore intersection" + ) + ( +"You are at the south end of First Street at Maple Ave." ;63 + "First-Maple intersection" + ) + ( +"You are at the intersection of First Street and Oaktree Ave." ;64 + "First-Oaktree intersection" + ) + ( +"You are at the intersection of First Street and Vermont Ave." ;65 + "First-Vermont intersection" + ) + ( +"You are at the north end of First Street at Sycamore Ave." ;66 + "First-Sycamore intersection" + ) + ( +"You are at the south end of Second Street at Maple Ave." ;67 + "Second-Maple intersection" + ) + ( +"You are at the intersection of Second Street and Oaktree Ave." ;68 + "Second-Oaktree intersection" + ) + ( +"You are at the intersection of Second Street and Vermont Ave." ;69 + "Second-Vermont intersection" + ) + ( +"You are at the north end of Second Street at Sycamore Ave." ;70 + "Second-Sycamore intersection" + ) + ( +"You are at the south end of Third Street at Maple Ave." ;71 + "Third-Maple intersection" + ) + ( +"You are at the intersection of Third Street and Oaktree Ave." ;72 + "Third-Oaktree intersection" + ) + ( +"You are at the intersection of Third Street and Vermont Ave." ;73 + "Third-Vermont intersection" + ) + ( +"You are at the north end of Third Street at Sycamore Ave." ;74 + "Third-Sycamore intersection" + ) + ( +"You are at the south end of Fourth Street at Maple Ave." ;75 + "Fourth-Maple intersection" + ) + ( +"You are at the intersection of Fourth Street and Oaktree Ave." ;76 + "Fourth-Oaktree intersection" + ) + ( +"You are at the intersection of Fourth Street and Vermont Ave." ;77 + "Fourth-Vermont intersection" + ) + ( +"You are at the north end of Fourth Street at Sycamore Ave." ;78 + "Fourth-Sycamore intersection" + ) + ( +"You are at the south end of Fifth Street at the east end of Maple Ave." ;79 + "Fifth-Maple intersection" + ) + ( +"You are at the intersection of Fifth Street and the east end of Oaktree Ave. +There is a cliff off to the east." + "Fifth-Oaktree intersection" ;80 + ) + ( +"You are at the intersection of Fifth Street and the east end of Vermont Ave." + "Fifth-Vermont intersection" ;81 + ) + ( +"You are at the north end of Fifth Street and the east end of Sycamore Ave." + "Fifth-Sycamore intersection" ;82 + ) + ( +"You are in front of the Museum of Natural History. A door leads into +the building to the north, and a road leads to the southeast." + "Museum entrance" ;83 + ) + ( +"You are in the main lobby for the Museum of Natural History. In the center +of the room is the huge skeleton of a dinosaur. Doors lead out to the +south and east." + "Museum lobby" ;84 + ) + ( +"You are in the geological display. All of the objects that used to +be on display are missing. There are rooms to the east, west, and +north." + "Geological display" ;85 + ) + ( +"You are in the marine life area. The room is filled with fish tanks, +which are filled with dead fish that have apparently died due to +starvation. Doors lead out to the south and east." + "Marine life area" ;86 + ) + ( +"You are in some sort of maintenance room for the museum. There is a +switch on the wall labeled 'BL'. There are doors to the west and north." + "Maintenance room" ;87 + ) + ( +"You are in a classroom where school children were taught about natural +history. On the blackboard is written, 'No children allowed downstairs.' +There is a door to the east with an 'exit' sign on it. There is another +door to the west." + "Classroom" ;88 + ) + ( +"You are at the Vermont St. subway station. A train is sitting here waiting." + "Vermont station" ;89 + ) + ( +"You are at the Museum subway stop. A passage leads off to the north." + "Museum station" ;90 + ) + ( +"You are in a north/south tunnel." + "N/S tunnel" ;91 + ) + ( +"You are at the north end of a north/south tunnel. Stairs lead up and +down from here. There is a garbage disposal here." + "North end of N/S tunnel" ;92 + ) + ( +"You are at the top of some stairs near the subway station. There is +a door to the west." + "Top of subway stairs" ;93 + ) + ( +"You are at the bottom of some stairs near the subway station. There is +a room to the northeast." + "Bottom of subway stairs" ;94 + ) + ( +"You are in another computer room. There is a computer in here larger +than you have ever seen. It has no manufacturers name on it, but it +does have a sign that says: This machine's name is 'endgame'. The +exit is to the southwest. There is no console here on which you could +type." + "Endgame computer room" ;95 + ) + ( +"You are in a north/south hallway." + "Endgame N/S hallway" ;96 + ) + ( +"You have reached a question room. You must answer a question correctly in +order to get by. Use the 'answer' command to answer the question." + "Question room 1" ;97 + ) + ( +"You are in a north/south hallway." + "Endgame N/S hallway" ;98 + ) + ( +"You are in a second question room." + "Question room 2" ;99 + ) + ( +"You are in a north/south hallway." + "Endgame N/S hallway" ;100 + ) + ( +"You are in a third question room." + "Question room 3" ;101 + ) + ( +"You are in the endgame treasure room. A door leads out to the north, and +a hallway leads to the south." + "Endgame treasure room" ;102 + ) + ( +"You are in the winner's room. A door leads back to the south." + "Winner's room" ;103 + ) + ( +"You have reached a dead end. There is a PC on the floor here. Above +it is a sign that reads: + Type the 'reset' command to type on the PC. +A hole leads north." + "PC area" ;104 + ) +)) + +(setq erbp-light-rooms '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 24 25 26 27 28 58 59 + 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 + 77 78 79 80 81 82 83)) + +(setq erbp-verblist '((die . erbp-die) (ne . erbp-ne) (north . erbp-n) + (south . erbp-s) (east . erbp-e) (west . erbp-w) + (u . erbp-up) (d . erbp-down) (i . erbp-inven) + (inventory . erbp-inven) (look . erbp-examine) (n . erbp-n) + (s . erbp-s) (e . erbp-e) (w . erbp-w) (se . erbp-se) + (nw . erbp-nw) (sw . erbp-sw) (up . erbp-up) + (down . erbp-down) (in . erbp-in) (out . erbp-out) + (go . erbp-go) (drop . erbp-drop) (southeast . erbp-se) + (southwest . erbp-sw) (northeast . erbp-ne) + (northwest . erbp-nw) (save . erbp-save-game) + (restore . erbp-restore) (long . erbp-long) (dig . erbp-dig) + (shake . erbp-shake) (wave . erbp-shake) + (examine . erbp-examine) (describe . erbp-examine) + (climb . erbp-climb) (eat . erbp-eat) (put . erbp-put) + (type . erbp-type) (insert . erbp-put) + (score . erbp-score) (help . erbp-help) (quit . erbp-quit) + (read . erbp-examine) (verbose . erbp-long) + (urinate . erbp-piss) (piss . erbp-piss) + (flush . erbp-flush) (sleep . erbp-sleep) (lie . erbp-sleep) + (x . erbp-examine) (break . erbp-break) (drive . erbp-drive) + (board . erbp-in) (enter . erbp-in) (turn . erbp-turn) + (press . erbp-press) (push . erbp-press) (swim . erbp-swim) + (on . erbp-in) (off . erbp-out) (chop . erbp-break) + (switch . erbp-press) (cut . erbp-break) (exit . erbp-out) + (leave . erbp-out) (reset . erbp-power) (flick . erbp-press) + (superb . erbp-superb) (answer . erbp-answer) + (throw . erbp-drop) (l . erbp-examine) (take . erbp-take) + (get . erbp-take) (feed . erbp-feed))) + +(setq erbp-inbus nil) +(setq erbp-nomail nil) +(setq erbp-ignore '(the to at)) +(setq erbp-mode 'moby) +(setq erbp-sauna-level 0) + +(defconst north 0) +(defconst south 1) +(defconst east 2) +(defconst west 3) +(defconst northeast 4) +(defconst southeast 5) +(defconst northwest 6) +(defconst southwest 7) +(defconst up 8) +(defconst down 9) +(defconst in 10) +(defconst out 11) + +(setq erbpeon-map '( +; no so ea we ne se nw sw up do in ot + ( 96 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;0 + ( -1 -1 2 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;1 + ( -1 -1 3 1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;2 + ( -1 -1 -1 2 4 6 -1 -1 -1 -1 -1 -1 ) ;3 + ( -1 -1 -1 -1 5 -1 -1 3 -1 -1 -1 -1 ) ;4 + ( -1 -1 -1 -1 255 -1 -1 4 -1 -1 255 -1 ) ;5 + ( -1 -1 -1 -1 -1 7 3 -1 -1 -1 -1 -1 ) ;6 + ( -1 -1 -1 -1 -1 255 6 27 -1 -1 -1 -1 ) ;7 + ( 255 5 9 10 -1 -1 -1 5 -1 -1 -1 5 ) ;8 + ( -1 -1 -1 8 -1 -1 -1 -1 -1 -1 -1 -1 ) ;9 + ( -1 -1 8 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;10 + ( -1 8 -1 58 -1 -1 -1 -1 -1 -1 -1 -1 ) ;11 + ( -1 -1 13 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;12 + ( 15 -1 14 12 -1 -1 -1 -1 -1 -1 -1 -1 ) ;13 + ( -1 -1 -1 13 -1 -1 -1 -1 -1 -1 -1 -1 ) ;14 + ( -1 13 16 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;15 + ( -1 -1 -1 15 -1 -1 -1 -1 -1 17 16 -1 ) ;16 + ( -1 -1 17 17 17 17 255 17 255 17 -1 -1 ) ;17 + ( 18 18 18 18 18 -1 18 18 19 18 -1 -1 ) ;18 + ( -1 18 18 19 19 20 19 19 -1 18 -1 -1 ) ;19 + ( -1 -1 -1 18 -1 -1 -1 -1 -1 21 -1 -1 ) ;20 + ( -1 -1 -1 -1 -1 20 22 -1 -1 -1 -1 -1 ) ;21 + ( 18 18 18 18 16 18 23 18 18 18 18 18 ) ;22 + ( -1 255 -1 -1 -1 19 -1 -1 -1 -1 -1 -1 ) ;23 + ( 23 25 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;24 + ( 24 255 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;25 + (255 28 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;26 + ( -1 -1 -1 -1 7 -1 -1 -1 -1 -1 -1 -1 ) ;27 + ( 26 255 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;28 + ( -1 -1 30 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;29 + ( -1 -1 31 29 -1 -1 -1 -1 -1 -1 -1 -1 ) ;30 + ( 32 33 -1 30 -1 -1 -1 -1 -1 -1 -1 -1 ) ;31 + ( -1 31 -1 255 -1 -1 -1 -1 -1 34 -1 -1 ) ;32 + ( 31 -1 -1 -1 -1 -1 -1 -1 -1 35 -1 -1 ) ;33 + ( -1 35 -1 -1 -1 -1 -1 -1 32 37 -1 -1 ) ;34 + ( 34 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;35 + ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;36 + ( -1 -1 -1 -1 -1 -1 -1 38 34 -1 -1 -1 ) ;37 + ( -1 -1 40 41 37 -1 -1 39 -1 -1 -1 -1 ) ;38 + ( -1 -1 -1 -1 38 -1 -1 -1 -1 -1 -1 -1 ) ;39 + ( -1 -1 -1 38 -1 -1 -1 -1 42 -1 -1 -1 ) ;40 + ( -1 -1 38 -1 -1 -1 -1 -1 -1 43 -1 -1 ) ;41 + ( -1 -1 -1 -1 -1 -1 -1 -1 -1 40 -1 -1 ) ;42 + ( 44 -1 46 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;43 + ( -1 43 45 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;44 + ( -1 46 -1 44 -1 -1 -1 -1 -1 -1 -1 -1 ) ;45 + ( 45 -1 -1 43 -1 -1 -1 -1 -1 255 -1 -1 ) ;46 + ( 48 50 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;47 + ( 49 47 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;48 + ( -1 48 -1 -1 -1 -1 -1 -1 52 -1 -1 -1 ) ;49 + ( 47 51 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;50 + ( 50 104 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;51 + ( -1 -1 -1 -1 -1 -1 -1 -1 53 49 -1 -1 ) ;52 + ( -1 -1 -1 -1 -1 -1 -1 -1 54 52 -1 -1 ) ;53 + ( -1 -1 -1 -1 55 -1 -1 -1 -1 53 -1 -1 ) ;54 + ( -1 -1 -1 -1 56 -1 -1 54 -1 -1 -1 54 ) ;55 + ( -1 -1 -1 -1 -1 -1 -1 55 -1 31 -1 -1 ) ;56 + ( -1 -1 32 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;57 + ( 59 -1 11 -1 -1 -1 -1 -1 -1 -1 255 255) ;58 + ( 60 58 63 -1 -1 -1 255 -1 -1 -1 255 255) ;59 + ( 61 59 64 -1 -1 -1 -1 -1 -1 -1 255 255) ;60 + ( 62 60 65 -1 -1 -1 -1 -1 -1 -1 255 255) ;61 + ( -1 61 66 -1 -1 -1 -1 -1 -1 -1 255 255) ;62 + ( 64 -1 67 59 -1 -1 -1 -1 -1 -1 255 255) ;63 + ( 65 63 68 60 -1 -1 -1 -1 -1 -1 255 255) ;64 + ( 66 64 69 61 -1 -1 -1 -1 -1 -1 255 255) ;65 + ( -1 65 70 62 -1 -1 -1 -1 -1 -1 255 255) ;66 + ( 68 -1 71 63 -1 -1 -1 -1 -1 -1 255 255) ;67 + ( 69 67 72 64 -1 -1 -1 -1 -1 -1 255 255) ;68 + ( 70 68 73 65 -1 -1 -1 -1 -1 -1 255 255) ;69 + ( -1 69 74 66 -1 -1 -1 -1 -1 -1 255 255) ;70 + ( 72 -1 75 67 -1 -1 -1 -1 -1 -1 255 255) ;71 + ( 73 71 76 68 -1 -1 -1 -1 -1 -1 255 255) ;72 + ( 74 72 77 69 -1 -1 -1 -1 -1 -1 255 255) ;73 + ( -1 73 78 70 -1 -1 -1 -1 -1 -1 255 255) ;74 + ( 76 -1 79 71 -1 -1 -1 -1 -1 -1 255 255) ;75 + ( 77 75 80 72 -1 -1 -1 -1 -1 -1 255 255) ;76 + ( 78 76 81 73 -1 -1 -1 -1 -1 -1 255 255) ;77 + ( -1 77 82 74 -1 -1 -1 -1 -1 -1 255 255) ;78 + ( 80 -1 -1 75 -1 -1 -1 -1 -1 -1 255 255) ;79 + ( 81 79 255 76 -1 -1 -1 -1 -1 -1 255 255) ;80 + ( 82 80 -1 77 -1 -1 -1 -1 -1 -1 255 255) ;81 + ( -1 81 -1 78 -1 -1 -1 -1 -1 -1 255 255) ;82 + ( 84 -1 -1 -1 -1 59 -1 -1 -1 -1 255 255) ;83 + ( -1 83 85 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;84 + ( 86 -1 87 84 -1 -1 -1 -1 -1 -1 -1 -1 ) ;85 + ( -1 85 88 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;86 + ( 88 -1 -1 85 -1 -1 -1 -1 -1 -1 -1 -1 ) ;87 + ( -1 87 255 86 -1 -1 -1 -1 -1 -1 -1 -1 ) ;88 + ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;89 + ( 91 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;90 + ( 92 90 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;91 + ( -1 91 -1 -1 -1 -1 -1 -1 93 94 -1 -1 ) ;92 + ( -1 -1 -1 88 -1 -1 -1 -1 -1 92 -1 -1 ) ;93 + ( -1 -1 -1 -1 95 -1 -1 -1 92 -1 -1 -1 ) ;94 + ( -1 -1 -1 -1 -1 -1 -1 94 -1 -1 -1 -1 ) ;95 + ( 97 0 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;96 + ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;97 + ( 99 97 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;98 + ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;99 + ( 101 99 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;100 + ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;101 + ( 103 101 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;102 + ( -1 102 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;103 + ( 51 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;104 + ) +; no so ea we ne se nw sw up do in ot +) + + +;;; How the user references *all* objects, permanent and regular. +(setq erbp-objnames '( + (shovel . 0) + (lamp . 1) + (cpu . 2) (board . 2) (card . 2) (chip . 2) + (food . 3) + (key . 4) + (paper . 5) (slip . 5) + (rms . 6) (statue . 6) (statuette . 6) (stallman . 6) + (diamond . 7) + (weight . 8) + (life . 9) (preserver . 9) + (bracelet . 10) (emerald . 10) + (gold . 11) + (platinum . 12) + (towel . 13) (beach . 13) + (axe . 14) + (silver . 15) + (license . 16) + (coins . 17) + (egg . 18) + (jar . 19) + (bone . 20) + (acid . 21) (nitric . 21) + (glycerine . 22) + (ruby . 23) + (amethyst . 24) + (mona . 25) + (bill . 26) + (floppy . 27) (disk . 27) + + (boulder . -1) + (tree . -2) (trees . -2) (palm . -2) + (bear . -3) + (bin . -4) (bins . -4) + (cabinet . -5) (computer . -5) (vax . -5) (ibm . -5) + (protoplasm . -6) + (dial . -7) + (button . -8) + (chute . -9) + (painting . -10) + (bed . -11) + (urinal . -12) + (URINE . -13) + (pipes . -14) (pipe . -14) + (box . -15) (slit . -15) + (cable . -16) (ethernet . -16) + (mail . -17) (drop . -17) + (bus . -18) + (gate . -19) + (cliff . -20) + (skeleton . -21) (dinosaur . -21) + (fish . -22) + (tanks . -23) (tank . -23) + (switch . -24) + (blackboard . -25) + (disposal . -26) (garbage . -26) + (ladder . -27) + (subway . -28) (train . -28) + (pc . -29) (drive . -29) (coconut . -30) (coconuts . -30) + (lake . -32) (water . -32) +)) + +(dolist (x erbp-objnames) + (let (name) + (setq name (concat "obj-" (prin1-to-string (car x)))) + (eval (list 'defconst (intern name) (cdr x))))) + +(defconst obj-special 255) + +;;; The initial setup of what objects are in each room. +;;; Regular objects have whole numbers lower than 255. +;;; Objects that cannot be taken but might move and are +;;; described during room description are negative. +;;; Stuff that is described and might change are 255, and are +;;; handled specially by 'erbp-describe-room. + +(setq erbp-room-objects (list nil + + (list obj-shovel) ;; treasure-room + (list obj-boulder) ;; dead-end + nil nil nil + (list obj-food) ;; se-nw-road + (list obj-bear) ;; bear-hangout + nil nil + (list obj-special) ;; computer-room + (list obj-lamp obj-license obj-silver);; meadow + nil nil + (list obj-special) ;; sauna + nil + (list obj-weight obj-life) ;; weight-room + nil nil + (list obj-rms obj-floppy) ;; thirsty-maze + nil nil nil nil nil nil nil + (list obj-emerald) ;; hidden-area + nil + (list obj-gold) ;; misty-room + nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil + (list obj-towel obj-special) ;; red-room + nil nil nil nil nil + (list obj-box) ;; stair-landing + nil nil nil + (list obj-axe) ;; smal-crawlspace + nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil + nil nil nil nil nil + (list obj-special) ;; fourth-vermont-intersection + nil nil + (list obj-coins) ;; fifth-oaktree-intersection + nil + (list obj-bus) ;; fifth-sycamore-intersection + nil + (list obj-bone) ;; museum-lobby + nil + (list obj-jar obj-special obj-ruby) ;; marine-life-area + (list obj-nitric) ;; maintenance-room + (list obj-glycerine) ;; classroom + nil nil nil nil nil + (list obj-amethyst) ;; bottom-of-subway-stairs + nil nil + (list obj-special) ;; question-room-1 + nil + (list obj-special) ;; question-room-2 + nil + (list obj-special) ;; question-room-three + nil + (list obj-mona) ;; winner's-room +nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil +nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil +nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil +nil)) + +;;; These are objects in a room that are only described in the +;;; room description. They are permanent. + +(setq erbp-room-silents (list nil + (list obj-tree obj-coconut) ;; dead-end + (list obj-tree obj-coconut) ;; e-w-dirt-road + nil nil nil nil nil nil + (list obj-bin) ;; mailroom + (list obj-computer) ;; computer-room + nil nil nil + (list obj-dial) ;; sauna + nil + (list obj-ladder) ;; weight-room + (list obj-button obj-ladder) ;; maze-button-room + nil nil nil + nil nil nil nil + (list obj-lake) ;; lakefront-north + (list obj-lake) ;; lakefront-south + nil + (list obj-chute) ;; cave-entrance + nil nil nil nil nil + (list obj-painting obj-bed) ;; bedroom + (list obj-urinal obj-pipes) ;; bathroom + nil nil nil nil nil nil + (list obj-boulder) ;; horseshoe-boulder-room + nil nil nil nil nil nil nil nil nil nil nil nil nil nil + (list obj-computer obj-cable) ;; gamma-computing-center + (list obj-mail) ;; post-office + (list obj-gate) ;; main-maple-intersection + nil nil nil nil nil nil nil nil nil nil nil nil nil + nil nil nil nil nil nil nil + (list obj-cliff) ;; fifth-oaktree-intersection + nil nil nil + (list obj-dinosaur) ;; museum-lobby + nil + (list obj-fish obj-tanks) ;; marine-life-area + (list obj-switch) ;; maintenance-room + (list obj-blackboard) ;; classroom + (list obj-train) ;; vermont-station + nil nil + (list obj-disposal) ;; north-end-of-n-s-tunnel + nil nil + (list obj-computer) ;; endgame-computer-room + nil nil nil nil nil nil nil nil + (list obj-pc) ;; pc-area + nil nil nil nil nil nil +)) +(setq erbp-inventory '(1)) + +;;; Descriptions of objects, as they appear in the room description, and +;;; the inventory. + +(setq erbp-objects '( + ("There is a shovel here." "A shovel") ;0 + ("There is a lamp nearby." "A lamp") ;1 + ("There is a CPU card here." "A computer board") ;2 + ("There is some food here." "Some food") ;3 + ("There is a shiny brass key here." "A brass key") ;4 + ("There is a slip of paper here." "A slip of paper") ;5 + ("There is a wax statuette of Richard Stallman here." ;6 + "An RMS statuette") + ("There is a shimmering diamond here." "A diamond") ;7 + ("There is a 10 pound weight here." "A weight") ;8 + ("There is a life preserver here." "A life preserver");9 + ("There is an emerald bracelet here." "A bracelet") ;10 + ("There is a gold bar here." "A gold bar") ;11 + ("There is a platinum bar here." "A platinum bar") ;12 + ("There is a beach towel on the ground here." "A beach towel") + ("There is an axe here." "An axe") ;14 + ("There is a silver bar here." "A silver bar") ;15 + ("There is a bus driver's license here." "A license") ;16 + ("There are some valuable coins here." "Some valuable coins") + ("There is a jewel-encrusted egg here." "A valuable egg") ;18 + ("There is a glass jar here." "A glass jar") ;19 + ("There is a dinosaur bone here." "A bone") ;20 + ("There is a packet of nitric acid here." "Some nitric acid") + ("There is a packet of glycerine here." "Some glycerine") ;22 + ("There is a valuable ruby here." "A ruby") ;23 + ("There is a valuable amethyst here." "An amethyst") ;24 + ("The Mona Lisa is here." "The Mona Lisa") ;25 + ("There is a 100 dollar bill here." "A $100 bill") ;26 + ("There is a floppy disk here." "A floppy disk") ;27 + ) +) + +;;; Weight of objects + +(setq erbp-object-lbs + '(2 1 1 1 1 0 2 2 10 3 1 1 1 0 1 1 0 1 1 1 1 0 0 2 2 1 0 0)) +(setq erbp-object-pts + '(0 0 0 0 0 0 0 10 0 0 10 10 10 0 0 10 0 10 10 0 0 0 0 10 10 10 10 0)) + + +;;; Unix representation of objects. +(setq erbp-objfiles '( + "shovel.o" "lamp.o" "cpu.o" "food.o" "key.o" "paper.o" + "rms.o" "diamond.o" "weight.o" "preserver.o" "bracelet.o" + "gold.o" "platinum.o" "towel.o" "axe.o" "silver.o" "license.o" + "coins.o" "egg.o" "jar.o" "bone.o" "nitric.o" "glycerine.o" + "ruby.o" "amethyst.o" + )) + +;;; These are the descriptions for the negative numbered objects from +;;; erbp-room-objects + +(setq erbp-perm-objects '( + nil + ("There is a large boulder here.") + nil + ("There is a ferocious bear here!") + nil + nil + ("There is a worthless pile of protoplasm here.") + nil + nil + nil + nil + nil + nil + ("There is a strange smell in this room.") + nil + ( +"There is a box with a slit in it, bolted to the wall here." + ) + nil + nil + ("There is a bus here.") + nil + nil + nil +)) + + +;;; These are the descriptions the user gets when regular objects are +;;; examined. + +(setq erbp-physobj-desc '( +"It is a normal shovel with a price tag attached that says $19.99." +"The lamp is hand-crafted by Geppetto." +"The CPU board has a VAX chip on it. It seems to have +2 Megabytes of RAM onboard." +"It looks like some kind of meat. Smells pretty bad." +nil +"The paper says: Don't forget to type 'help' for help. Also, remember +this word: 'worms'" +"The statuette is of the likeness of Richard Stallman, the author of the +famous EMACS editor. You notice that he is not wearing any shoes." +nil +"You observe that the weight is heavy." +"It says S. S. Minnow." +nil +nil +nil +"It has a picture of snoopy on it." +nil +nil +"It has your picture on it!" +"They are old coins from the 19th century." +"It is a valuable Fabrege egg." +"It is a a plain glass jar." +nil +nil +nil +nil +nil + ) +) + +;;; These are the descriptions the user gets when non-regular objects +;;; are examined. + +(setq erbp-permobj-desc '( + nil +"It is just a boulder. It cannot be moved." +"They are palm trees with a bountiful supply of coconuts in them." +"It looks like a grizzly to me." +"All of the bins are empty. Looking closely you can see that there +are names written at the bottom of each bin, but most of them are +faded away so that you cannot read them. You can only make out three +names: + Jeffrey Collier + Robert Toukmond + Thomas Stock +" + nil +"It is just a garbled mess." +"The dial points to a temperature scale which has long since faded away." +nil +nil +"It is a velvet painting of Elvis Presley. It seems to be nailed to the +wall, and you cannot move it." +"It is a queen sized bed, with a very firm mattress." +"The urinal is very clean compared with everything else in the cave. There +isn't even any rust. Upon close examination you realize that the drain at the +bottom is missing, and there is just a large hole leading down the +pipes into nowhere. The hole is too small for a person to fit in. The +flush handle is so clean that you can see your reflection in it." +nil +nil +"The box has a slit in the top of it, and on it, in sloppy handwriting, is +written: 'For key upgrade, put key in here.'" +nil +"It says 'express mail' on it." +"It is a 35 passenger bus with the company name 'mobytours' on it." +"It is a large metal gate that is too big to climb over." +"It is a HIGH cliff." +"Unfortunately you do not know enough about dinosaurs to tell very much about +it. It is very big, though." +"The fish look like they were once quite beautiful." +nil +nil +nil +nil +"It is a normal ladder that is permanently attached to the hole." +"It is a passenger train that is ready to go." +"It is a personal computer that has only one floppy disk drive." + ) +) + +(setq erbp-diggables + (list nil nil nil (list obj-cpu) nil nil nil nil nil nil nil + nil nil nil nil nil nil nil nil nil nil ;11-20 + nil nil nil nil nil nil nil nil nil nil ;21-30 + nil nil nil nil nil nil nil nil nil nil ;31-40 + nil (list obj-platinum) nil nil nil nil nil nil nil nil)) + +(setq erbp-room-shorts nil) +(dolist (x erbp-rooms) + (setq erbp-room-shorts + (append erbp-room-shorts (list (downcase + (erbp-space-to-hyphen + (cadr x))))))) + +(setq erbp-endgame-questions '( + ( +"What is your password on the machine called 'pokey'?" "robert") + ( +"What password did you use during anonymous ftp to gamma?" "foo") + ( +"Excluding the endgame, how many places are there where you can put +treasures for points?" "4" "four") + ( +"What is your login name on the 'endgame' machine?" "toukmond" +) + ( +"What is the nearest whole dollar to the price of the shovel?" "20" "twenty") + ( +"What is the name of the bus company serving the town?" "mobytours") + ( +"Give either of the two last names in the mailroom, other than your own." +"collier" "stock") + ( +"What cartoon character is on the towel?" "snoopy") + ( +"What is the last name of the author of EMACS?" "stallman") + ( +"How many megabytes of memory is on the CPU board for the Vax?" "2") + ( +"Which street in town is named after a U.S. state?" "vermont") + ( +"How many pounds did the weight weigh?" "ten" "10") + ( +"Name the STREET which runs right over the subway stop." "fourth" "4" "4th") + ( +"How many corners are there in town (excluding the one with the Post Office)?" + "24" "twentyfour" "twenty-four") + ( +"What type of bear was hiding your key?" "grizzly") + ( +"Name either of the two objects you found by digging." "cpu" "card" "vax" +"board" "platinum") + ( +"What network protocol is used between pokey and gamma?" "tcp/ip" "ip" "tcp") +)) + +(let (a) + (setq a 0) + (dolist (x erbp-room-shorts) + (eval (list 'defconst (intern x) a)) + (setq a (+ a 1)))) + + + +;;;; +;;;; This section defines the UNIX emulation functions for erbpnet. +;;;; + +(defun erbp-unix-parse (args) + (interactive "*p") + (beginning-of-line) + (let (beg esign) + (setq beg (+ (point) 2)) + (end-of-line) + (if (and (not (= beg (point))) + (string= "$" (buffer-substring (- beg 2) (- beg 1)))) + (progn + (setq line (downcase (buffer-substring beg (point)))) + (princ line) + (if (eq (erbp-parse2 nil erbp-unix-verbs line) -1) + (progn + (if (setq esign (string-match "=" line)) + (erbp-doassign line esign) + (erbp-mprinc (car line-list)) + (erbp-mprincl ": not found."))))) + (goto-char (point-max)) + (erbp-mprinc "\n")) + (if (eq erbpeon-mode 'unix) + (progn + (erbp-fix-screen) + (erbp-mprinc "$ "))))) + +(defun erbp-doassign (line esign) + (if (not erbp-wizard) + (let (passwd) + (erbp-mprinc "Enter wizard password: ") + (setq passwd (erbp-read-line)) + (if (not erbp-batch-mode) + (erbp-mprinc "\n")) + (if (string= passwd "moby") + (progn + (setq erbp-wizard t) + (erbp-doassign line esign)) + (erbp-mprincl "Incorrect."))) + + (let (varname epoint afterq i value) + (setq varname (substring line 0 esign)) + (if (not (setq epoint (string-match ")" line))) + (if (string= (substring line (1+ esign) (+ esign 2)) + "\"") + (progn + (setq afterq (substring line (+ esign 2))) + (setq epoint (+ + (string-match "\"" afterq) + (+ esign 3)))) + + (if (not (setq epoint (string-match " " line))) + (setq epoint (length line)))) + (setq epoint (1+ epoint)) + (while (and + (not (= epoint (length line))) + (setq i (string-match ")" (substring line epoint)))) + (setq epoint (+ epoint i 1)))) + (setq value (substring line (1+ esign) epoint)) + (erbp-eval varname value)))) + +(defun erbp-eval (varname value) + (let (eval-error) + (switch-to-buffer (get-buffer-create "*erbpeon-eval*")) + (erase-buffer) + (insert "(setq ") + (insert varname) + (insert " ") + (insert value) + (insert ")") + (setq eval-error nil) + (condition-case nil + (eval-current-buffer) + (error (setq eval-error t))) + (kill-buffer (current-buffer)) + (switch-to-buffer "*erbpeon*") + (if eval-error + (erbp-mprincl "Invalid syntax.")))) + + +(defun erbp-unix-interface () + (erbp-login) + (if erbp-logged-in + (progn + (setq erbpeon-mode 'unix) + (define-key erbpeon-mode-map "\r" 'erbp-unix-parse) + (erbp-mprinc "$ ")))) + +(defun erbp-login () + (let (tries username password) + (setq tries 4) + (while (and (not erbp-logged-in) (> (setq tries (- tries 1)) 0)) + (erbp-mprinc "\n\nUNIX System V, Release 2.2 (pokey)\n\nlogin: ") + (setq username (erbp-read-line)) + (if (not erbp-batch-mode) + (erbp-mprinc "\n")) + (erbp-mprinc "password: ") + (setq password (erbp-read-line)) + (if (not erbp-batch-mode) + (erbp-mprinc "\n")) + (if (or (not (string= username "toukmond")) + (not (string= password "robert"))) + (erbp-mprincl "login incorrect") + (setq erbp-logged-in t) + (erbp-mprincl " +Welcome to Unix\n +Please clean up your directories. The filesystem is getting full. +Our tcp/ip link to gamma is a little flaky, but seems to work. +The current version of ftp can only send files from your home +directory, and deletes them after they are sent! Be careful. + +Note: Restricted bourne shell in use.\n"))) + (setq erbpeon-mode 'erbpeon))) + +(defun erbp-ls (args) + (if (car args) + (let (ocdpath ocdroom) + (setq ocdpath erbp-cdpath) + (setq ocdroom erbp-cdroom) + (if (not (eq (erbp-cd args) -2)) + (erbp-ls nil)) + (setq erbp-cdpath ocdpath) + (setq erbp-cdroom ocdroom)) + (if (= erbp-cdroom -10) + (erbp-ls-inven)) + (if (= erbp-cdroom -2) + (erbp-ls-rooms)) + (if (= erbp-cdroom -3) + (erbp-ls-root)) + (if (= erbp-cdroom -4) + (erbp-ls-usr)) + (if (> erbp-cdroom 0) + (erbp-ls-room)))) + +(defun erbp-ls-root () + (erbp-mprincl "total 4 +drwxr-xr-x 3 root staff 512 Jan 1 1970 . +drwxr-xr-x 3 root staff 2048 Jan 1 1970 .. +drwxr-xr-x 3 root staff 2048 Jan 1 1970 usr +drwxr-xr-x 3 root staff 2048 Jan 1 1970 rooms")) + +(defun erbp-ls-usr () + (erbp-mprincl "total 4 +drwxr-xr-x 3 root staff 512 Jan 1 1970 . +drwxr-xr-x 3 root staff 2048 Jan 1 1970 .. +drwxr-xr-x 3 toukmond restricted 512 Jan 1 1970 toukmond")) + +(defun erbp-ls-rooms () + (erbp-mprincl "total 16 +drwxr-xr-x 3 root staff 512 Jan 1 1970 . +drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..") + (dolist (x erbp-visited) + (erbp-mprinc +"drwxr-xr-x 3 root staff 512 Jan 1 1970 ") + (erbp-mprincl (nth x erbp-room-shorts)))) + +(defun erbp-ls-room () + (erbp-mprincl "total 4 +drwxr-xr-x 3 root staff 512 Jan 1 1970 . +drwxr-xr-x 3 root staff 2048 Jan 1 1970 .. +-rwxr-xr-x 3 root staff 2048 Jan 1 1970 description") + (dolist (x (nth erbp-cdroom erbp-room-objects)) + (if (and (>= x 0) (not (= x 255))) + (progn + (erbp-mprinc "-rwxr-xr-x 1 toukmond restricted 0 Jan 1 1970 ") + (erbp-mprincl (nth x erbp-objfiles)))))) + +(defun erbp-ls-inven () + (erbp-mprinc "total 467 +drwxr-xr-x 3 toukmond restricted 512 Jan 1 1970 . +drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..") + (dolist (x erbp-unix-verbs) + (if (not (eq (car x) 'IMPOSSIBLE)) + (progn + (erbp-mprinc" +-rwxr-xr-x 1 toukmond restricted 10423 Jan 1 1970 ") + (erbp-mprinc (car x))))) + (erbp-mprinc "\n") + (if (not erbp-uncompressed) + (erbp-mprincl +"-rwxr-xr-x 1 toukmond restricted 0 Jan 1 1970 paper.o.Z")) + (dolist (x erbp-inventory) + (erbp-mprinc +"-rwxr-xr-x 1 toukmond restricted 0 Jan 1 1970 ") + (erbp-mprincl (nth x erbp-objfiles)))) + +(defun erbp-echo (args) + (let (nomore var) + (setq nomore nil) + (dolist (x args) + (if (not nomore) + (progn + (if (not (string= (substring x 0 1) "$")) + (progn + (erbp-mprinc x) + (erbp-mprinc " ")) + (setq var (intern (substring x 1))) + (if (not (boundp var)) + (erbp-mprinc " ") + (if (member var erbp-restricted) + (progn + (erbp-mprinc var) + (erbp-mprinc ": Permission denied") + (setq nomore t)) + (eval (list 'erbp-mprinc var)) + (erbp-mprinc " "))))))) + (erbp-mprinc "\n"))) + + +(defun erbp-ftp (args) + (let (host username passwd ident newlist) + (if (not (car args)) + (erbp-mprincl "ftp: hostname required on command line.") + (setq host (intern (car args))) + (if (not (member host '(gamma erbp-endgame))) + (erbp-mprincl "ftp: Unknown host.") + (if (eq host 'erbp-endgame) + (erbp-mprincl "ftp: connection to endgame not allowed") + (if (not erbp-ethernet) + (erbp-mprincl "ftp: host not responding.") + (erbp-mprincl "Connected to gamma. FTP ver 0.9 00:00:00 01/01/70") + (erbp-mprinc "Username: ") + (setq username (erbp-read-line)) + (if (string= username "toukmond") + (if erbp-batch-mode + (erbp-mprincl "toukmond ftp access not allowed.") + (erbp-mprincl "\ntoukmond ftp access not allowed.")) + (if (string= username "anonymous") + (if erbp-batch-mode + (erbp-mprincl + "Guest login okay, send your user ident as password.") + (erbp-mprincl + "\nGuest login okay, send your user ident as password.")) + (if erbp-batch-mode + (erbp-mprinc "Password required for ") + (erbp-mprinc "\nPassword required for ")) + (erbp-mprincl username)) + (erbp-mprinc "Password: ") + (setq ident (erbp-read-line)) + (if (not (string= username "anonymous")) + (if erbp-batch-mode + (erbp-mprincl "Login failed.") + (erbp-mprincl "\nLogin failed.")) + (if erbp-batch-mode + (erbp-mprincl + "Guest login okay, user access restrictions apply.") + (erbp-mprincl + "\nGuest login okay, user access restrictions apply.")) + (erbp-ftp-commands) + (setq newlist +'("What password did you use during anonymous ftp to gamma?")) + (setq newlist (append newlist (list ident))) + (rplaca (nthcdr 1 erbp-endgame-questions) newlist))))))))) + +(defun erbp-ftp-commands () + (setq erbp-exitf nil) + (let (line) + (while (not erbp-exitf) + (erbp-mprinc "ftp> ") + (setq line (erbp-read-line)) + (if + (eq + (erbp-parse2 nil + '((type . erbp-ftptype) (binary . erbp-bin) (bin . erbp-bin) + (send . erbp-send) (put . erbp-send) (quit . erbp-ftpquit) + (help . erbp-ftphelp)(ascii . erbp-fascii) + ) line) + -1) + (erbp-mprincl "No such command. Try help."))) + (setq erbp-ftptype 'ascii))) + +(defun erbp-ftptype (args) + (if (not (car args)) + (erbp-mprincl "Usage: type [binary | ascii]") + (setq args (intern (car args))) + (if (eq args 'binary) + (erbp-bin nil) + (if (eq args 'ascii) + (erbp-fascii 'nil) + (erbp-mprincl "Unknown type."))))) + +(defun erbp-bin (args) + (erbp-mprincl "Type set to binary.") + (setq erbp-ftptype 'binary)) + +(defun erbp-fascii (args) + (erbp-mprincl "Type set to ascii.") + (setq erbp-ftptype 'ascii)) + +(defun erbp-ftpquit (args) + (setq erbp-exitf t)) + +(defun erbp-send (args) + (if (not (car args)) + (erbp-mprincl "Usage: send <filename>") + (setq args (car args)) + (let (counter foo) + (setq foo nil) + (setq counter 0) + +;;; User can send commands! Stupid user. + + + (if (assq (intern args) erbp-unix-verbs) + (progn + (rplaca (assq (intern args) erbp-unix-verbs) 'IMPOSSIBLE) + (erbp-mprinc "Sending ") + (erbp-mprinc erbp-ftptype) + (erbp-mprinc " file for ") + (erbp-mprincl args) + (erbp-mprincl "Transfer complete.")) + + (dolist (x erbp-objfiles) + (if (string= args x) + (progn + (if (not (member counter erbp-inventory)) + (progn + (erbp-mprincl "No such file.") + (setq foo t)) + (erbp-mprinc "Sending ") + (erbp-mprinc erbp-ftptype) + (erbp-mprinc " file for ") + (erbp-mprinc (downcase (cadr (nth counter erbp-objects)))) + (erbp-mprincl ", (0 bytes)") + (if (not (eq erbp-ftptype 'binary)) + (progn + (if (not (member obj-protoplasm + (nth receiving-room + erbp-room-objects))) + (erbp-replace erbp-room-objects receiving-room + (append (nth receiving-room + erbp-room-objects) + (list obj-protoplasm)))) + (erbp-remove-obj-from-inven counter)) + (erbp-remove-obj-from-inven counter) + (erbp-replace erbp-room-objects receiving-room + (append (nth receiving-room erbp-room-objects) + (list counter)))) + (setq foo t) + (erbp-mprincl "Transfer complete.")))) + (setq counter (+ 1 counter))) + (if (not foo) + (erbp-mprincl "No such file.")))))) + +(defun erbp-ftphelp (args) + (erbp-mprincl + "Possible commands are:\nsend quit type ascii binary help")) + +(defun erbp-uexit (args) + (setq erbpeon-mode 'erbpeon) + (erbp-mprincl "\nYou step back from the console.") + (define-key erbpeon-mode-map "\r" 'erbp-parse) + (if (not erbp-batch-mode) + (erbp-messages))) + +(defun erbp-pwd (args) + (erbp-mprincl erbp-cdpath)) + +(defun erbp-uncompress (args) + (if (not (car args)) + (erbp-mprincl "Usage: uncompress <filename>") + (setq args (car args)) + (if (or erbp-uncompressed + (and (not (string= args "paper.o")) + (not (string= args "paper.o.z")))) + (erbp-mprincl "Uncompress command failed.") + (setq erbp-uncompressed t) + (setq erbp-inventory (append erbp-inventory (list obj-paper)))))) + +(defun erbp-rlogin (args) + (let (passwd) + (if (not (car args)) + (erbp-mprincl "Usage: rlogin <hostname>") + (setq args (car args)) + (if (string= args "endgame") + (erbp-rlogin-endgame) + (if (not (string= args "gamma")) + (if (string= args "pokey") + (erbp-mprincl "Can't rlogin back to localhost") + (erbp-mprincl "No such host.")) + (if (not erbp-ethernet) + (erbp-mprincl "Host not responding.") + (erbp-mprinc "Password: ") + (setq passwd (erbp-read-line)) + (if (not (string= passwd "worms")) + (erbp-mprincl "\nlogin incorrect") + (erbp-mprinc +"\nYou begin to feel strange for a moment, and you lose your items." +) + (erbp-replace erbp-room-objects computer-room + (append (nth computer-room erbp-room-objects) + erbp-inventory)) + (setq erbp-inventory nil) + (setq erbp-current-room receiving-room) + (erbp-uexit nil)))))))) + +(defun erbp-cd (args) + (let (tcdpath tcdroom path-elements room-check) + (if (not (car args)) + (erbp-mprincl "Usage: cd <path>") + (setq tcdpath erbp-cdpath) + (setq tcdroom erbp-cdroom) + (setq erbp-badcd nil) + (condition-case nil + (setq path-elements (erbp-get-path (car args) nil)) + (error (erbp-mprincl "Invalid path") + (setq erbp-badcd t))) + (dolist (pe path-elements) + (unless erbp-badcd + (if (not (string= pe ".")) + (if (string= pe "..") + (progn + (if (> tcdroom 0) ;In a room + (progn + (setq tcdpath "/rooms") + (setq tcdroom -2)) + ;In /rooms,/usr,root + (if (or + (= tcdroom -2) (= tcdroom -4) + (= tcdroom -3)) + (progn + (setq tcdpath "/") + (setq tcdroom -3)) + (if (= tcdroom -10) ;In /usr/toukmond + (progn + (setq tcdpath "/usr") + (setq tcdroom -4)))))) + (if (string= pe "/") + (progn + (setq tcdpath "/") + (setq tcdroom -3)) + (if (= tcdroom -4) + (if (string= pe "toukmond") + (progn + (setq tcdpath "/usr/toukmond") + (setq tcdroom -10)) + (erbp-nosuchdir)) + (if (= tcdroom -10) + (erbp-nosuchdir) + (if (> tcdroom 0) + (erbp-nosuchdir) + (if (= tcdroom -3) + (progn + (if (string= pe "rooms") + (progn + (setq tcdpath "/rooms") + (setq tcdroom -2)) + (if (string= pe "usr") + (progn + (setq tcdpath "/usr") + (setq tcdroom -4)) + (erbp-nosuchdir)))) + (if (= tcdroom -2) + (progn + (dolist (x erbp-visited) + (setq room-check + (nth x + erbp-room-shorts)) + (if (string= room-check pe) + (progn + (setq tcdpath + (concat "/rooms/" room-check)) + (setq tcdroom x)))) + (if (= tcdroom -2) + (erbp-nosuchdir))))))))))))) + (if (not erbp-badcd) + (progn + (setq erbp-cdpath tcdpath) + (setq erbp-cdroom tcdroom) + 0) + -2)))) + +(defun erbp-nosuchdir () + (erbp-mprincl "No such directory.") + (setq erbp-badcd t)) + +(defun erbp-cat (args) + (let (doto checklist) + (if (not (setq args (car args))) + (erbp-mprincl "Usage: cat <ascii-file-name>") + (if (string-match "/" args) + (erbp-mprincl "cat: only files in current directory allowed.") + (if (and (> erbp-cdroom 0) (string= args "description")) + (erbp-mprincl (car (nth erbp-cdroom erbp-rooms))) + (if (setq doto (string-match "\\.o" args)) + (progn + (if (= erbp-cdroom -10) + (setq checklist erbp-inventory) + (setq checklist (nth erbp-cdroom erbp-room-objects))) + (if (not (member (cdr + (assq (intern + (substring args 0 doto)) + erbp-objnames)) + checklist)) + (erbp-mprincl "File not found.") + (erbp-mprincl "Ascii files only."))) + (if (assq (intern args) erbp-unix-verbs) + (erbp-mprincl "Ascii files only.") + (erbp-mprincl "File not found.")))))))) + +(defun erbp-zippy (args) + (erbp-mprincl (yow))) + +(defun erbp-rlogin-endgame () + (if (not (= (erbp-score nil) 90)) + (erbp-mprincl + "You have not achieved enough points to connect to endgame.") + (erbp-mprincl"\nWelcome to the endgame. You are a truly noble adventurer.") + (setq erbp-current-room treasure-room) + (setq erbp-endgame t) + (erbp-replace erbp-room-objects endgame-treasure-room (list obj-bill)) + (erbp-uexit nil))) + + +(random t) +(setq tloc (+ 60 (random 18))) +(erbp-replace erbp-room-objects tloc + (append (nth tloc erbp-room-objects) (list 18))) + +(setq tcomb (+ 100 (random 899))) +(setq erbp-combination (prin1-to-string tcomb)) + +;;;; +;;;; This section defines the DOS emulation functions for erbpnet +;;;; + +(defun erbp-dos-parse (args) + (interactive "*p") + (beginning-of-line) + (let (beg) + (setq beg (+ (point) 3)) + (end-of-line) + (if (not (= beg (point))) + (let (line) + (setq line (downcase (buffer-substring beg (point)))) + (princ line) + (if (eq (erbp-parse2 nil erbp-dos-verbs line) -1) + (progn + (sleep-for 1) + (erbp-mprincl "Bad command or file name")))) + (goto-char (point-max)) + (erbp-mprinc "\n")) + (if (eq erbpeon-mode 'dos) + (progn + (erbp-fix-screen) + (erbp-dos-prompt))))) + +(defun erbp-dos-interface () + (erbp-dos-boot-msg) + (setq erbpeon-mode 'dos) + (define-key erbpeon-mode-map "\r" 'erbp-dos-parse) + (erbp-dos-prompt)) + +(defun erbp-dos-type (args) + (sleep-for 2) + (if (setq args (car args)) + (if (string= args "foo.txt") + (erbp-dos-show-combination) + (if (string= args "command.com") + (erbp-mprincl "Cannot type binary files") + (erbp-mprinc "File not found - ") + (erbp-mprincl (upcase args)))) + (erbp-mprincl "Must supply file name"))) + +(defun erbp-dos-invd (args) + (sleep-for 1) + (erbp-mprincl "Invalid drive specification")) + +(defun erbp-dos-dir (args) + (sleep-for 1) + (if (or (not (setq args (car args))) (string= args "\\")) + (erbp-mprincl " + Volume in drive A is FOO + Volume Serial Number is 1A16-08C9 + Directory of A:\\ + +COMMAND COM 47845 04-09-91 2:00a +FOO TXT 40 01-20-93 1:01a + 2 file(s) 47845 bytes + 1065280 bytes free +") + (erbp-mprincl " + Volume in drive A is FOO + Volume Serial Number is 1A16-08C9 + Directory of A:\\ + +File not found"))) + + +(defun erbp-dos-prompt () + (erbp-mprinc "A> ")) + +(defun erbp-dos-boot-msg () + (sleep-for 3) + (erbp-mprinc "Current time is ") + (erbp-mprincl (substring (current-time-string) 12 20)) + (erbp-mprinc "Enter new time: ") + (erbp-read-line) + (if (not erbp-batch-mode) + (erbp-mprinc "\n"))) + +(defun erbp-dos-spawn (args) + (sleep-for 1) + (erbp-mprincl "Cannot spawn subshell")) + +(defun erbp-dos-exit (args) + (setq erbpeon-mode 'erbpeon) + (erbp-mprincl "\nYou power down the machine and step back.") + (define-key erbpeon-mode-map "\r" 'erbp-parse) + (if (not erbp-batch-mode) + (erbp-messages))) + +(defun erbp-dos-no-disk () + (sleep-for 3) + (erbp-mprincl "Boot sector not found")) + + +(defun erbp-dos-show-combination () + (sleep-for 2) + (erbp-mprinc "\nThe combination is ") + (erbp-mprinc erbp-combination) + (erbp-mprinc ".\n")) + +(defun erbp-dos-nil (args)) + + +;;;; +;;;; This section defines the save and restore game functions for erbpnet. +;;;; + +(defun erbp-save-game (filename) + (if (not (setq filename (car filename))) + (erbp-mprincl "You must supply a filename for the save.") + (if (file-exists-p filename) + (delete-file filename)) + (setq erbp-numsaves (1+ erbp-numsaves)) + (erbp-make-save-buffer) + (erbp-save-val "erbp-current-room") + (erbp-save-val "erbp-computer") + (erbp-save-val "erbp-combination") + (erbp-save-val "erbp-visited") + (erbp-save-val "erbp-diggables") + (erbp-save-val "erbp-key-level") + (erbp-save-val "erbp-floppy") + (erbp-save-val "erbp-numsaves") + (erbp-save-val "erbp-numcmds") + (erbp-save-val "erbp-logged-in") + (erbp-save-val "erbpeon-mode") + (erbp-save-val "erbp-jar") + (erbp-save-val "erbp-lastdir") + (erbp-save-val "erbp-black") + (erbp-save-val "erbp-nomail") + (erbp-save-val "erbp-unix-verbs") + (erbp-save-val "erbp-hole") + (erbp-save-val "erbp-uncompressed") + (erbp-save-val "erbp-ethernet") + (erbp-save-val "erbp-sauna-level") + (erbp-save-val "erbp-room-objects") + (erbp-save-val "erbp-room-silents") + (erbp-save-val "erbp-inventory") + (erbp-save-val "erbp-endgame-questions") + (erbp-save-val "erbp-endgame") + (erbp-save-val "erbp-cdroom") + (erbp-save-val "erbp-cdpath") + (erbp-save-val "erbp-correct-answer") + (erbp-save-val "erbp-inbus") + (if (erbp-compile-save-out filename) + (erbp-mprincl "Error saving to file.") + (erbp-do-logfile 'save nil) + (switch-to-buffer "*erbpeon*") + (princ "") + (erbp-mprincl "Done.")))) + +(defun erbp-make-save-buffer () + (switch-to-buffer (get-buffer-create "*save-erbpeon*")) + (erase-buffer)) + +(defun erbp-compile-save-out (filename) + (let (ferror) + (setq ferror nil) + (condition-case nil + (erbp-rot13) + (error (setq ferror t))) + (if (not ferror) + (progn + (goto-char (point-min)))) + (condition-case nil + (write-region 1 (point-max) filename nil 1) + (error (setq ferror t))) + (kill-buffer (current-buffer)) + ferror)) + + +(defun erbp-save-val (varname) + (let (value) + (setq varname (intern varname)) + (setq value (eval varname)) + (erbp-minsert "(setq ") + (erbp-minsert varname) + (erbp-minsert " ") + (if (or (listp value) + (symbolp value)) + (erbp-minsert "'")) + (if (stringp value) + (erbp-minsert "\"")) + (erbp-minsert value) + (if (stringp value) + (erbp-minsert "\"")) + (erbp-minsertl ")"))) + + +(defun erbp-restore (args) + (let (file) + (if (not (setq file (car args))) + (erbp-mprincl "You must supply a filename.") + (if (not (erbp-load-d file)) + (erbp-mprincl "Could not load restore file.") + (erbp-mprincl "Done.") + (setq room 0))))) + + +(defun erbp-do-logfile (type how) + (let (ferror newscore) + (setq ferror nil) + (switch-to-buffer (get-buffer-create "*score*")) + (erase-buffer) + (condition-case nil + (insert-file-contents erbp-log-file) + (error (setq ferror t))) + (unless ferror + (goto-char (point-max)) + (erbp-minsert (current-time-string)) + (erbp-minsert " ") + (erbp-minsert (user-login-name)) + (erbp-minsert " ") + (if (eq type 'save) + (erbp-minsert "saved ") + (if (= (erbp-endgame-score) 110) + (erbp-minsert "won ") + (if (not how) + (erbp-minsert "quit ") + (erbp-minsert "killed by ") + (erbp-minsert how) + (erbp-minsert " ")))) + (erbp-minsert "at ") + (erbp-minsert (cadr (nth (abs room) erbp-rooms))) + (erbp-minsert ". score: ") + (if (> (erbp-endgame-score) 0) + (erbp-minsert (setq newscore (+ 90 (erbp-endgame-score)))) + (erbp-minsert (setq newscore (erbp-reg-score)))) + (erbp-minsert " saves: ") + (erbp-minsert erbp-numsaves) + (erbp-minsert " commands: ") + (erbp-minsert erbp-numcmds) + (erbp-minsert "\n") + (write-region 1 (point-max) erbp-log-file nil 1)) + (kill-buffer (current-buffer)))) + + +;;;; +;;;; These are functions, and function re-definitions so that erbpeon can +;;;; be run in batch mode. + + +(defun erbp-batch-mprinc (arg) + (if (stringp arg) + (send-string-to-terminal arg) + (send-string-to-terminal (prin1-to-string arg)))) + + +(defun erbp-batch-mprincl (arg) + (if (stringp arg) + (progn + (send-string-to-terminal arg) + (send-string-to-terminal "\n")) + (send-string-to-terminal (prin1-to-string arg)) + (send-string-to-terminal "\n"))) + +(defun erbp-batch-parse (erbp-ignore erbp-verblist line) + (setq line-list (erbp-listify-string (concat line " "))) + (erbp-doverb erbp-ignore erbp-verblist (car line-list) (cdr line-list))) + +(defun erbp-batch-parse2 (erbp-ignore erbp-verblist line) + (setq line-list (erbp-listify-string2 (concat line " "))) + (erbp-doverb erbp-ignore erbp-verblist (car line-list) (cdr line-list))) + +(defun erbp-batch-read-line () + (read-from-minibuffer "" nil erbpeon-batch-map)) + + +(defun erbp-batch-loop () + (setq erbp-dead nil) + (setq room 0) + (while (not erbp-dead) + (if (eq erbpeon-mode 'erbpeon) + (progn + (if (not (= room erbp-current-room)) + (progn + (erbp-describe-room erbp-current-room) + (setq room erbp-current-room))) + (erbp-mprinc ">") + (setq line (downcase (erbp-read-line))) + (if (eq (erbp-vparse erbp-ignore erbp-verblist line) -1) + (erbp-mprinc "I don't understand that.\n")))))) + +(defun erbp-batch-dos-interface () + (erbp-dos-boot-msg) + (setq erbpeon-mode 'dos) + (while (eq erbpeon-mode 'dos) + (erbp-dos-prompt) + (setq line (downcase (erbp-read-line))) + (if (eq (erbp-parse2 nil erbp-dos-verbs line) -1) + (progn + (sleep-for 1) + (erbp-mprincl "Bad command or file name")))) + (goto-char (point-max)) + (erbp-mprinc "\n")) + +(defun erbp-batch-unix-interface () + (erbp-login) + (if erbp-logged-in + (progn + (setq erbpeon-mode 'unix) + (while (eq erbpeon-mode 'unix) + (erbp-mprinc "$ ") + (setq line (downcase (erbp-read-line))) + (if (eq (erbp-parse2 nil erbp-unix-verbs line) -1) + (let (esign) + (if (setq esign (string-match "=" line)) + (erbp-doassign line esign) + (erbp-mprinc (car line-list)) + (erbp-mprincl ": not found."))))) + (goto-char (point-max)) + (erbp-mprinc "\n")))) + +(defun erbpeon-nil (arg) + "noop" + (interactive "*p") + nil) + +(defun erbp-batch-erbpeon () + (load "erbp-batch") + (setq erbp-visited '(27)) + (erbp-mprinc "\n") + (erbp-batch-loop)) + +(unless (not noninteractive) + (fset 'erbp-mprinc 'erbp-batch-mprinc) + (fset 'erbp-mprincl 'erbp-batch-mprincl) + (fset 'erbp-vparse 'erbp-batch-parse) + (fset 'erbp-parse2 'erbp-batch-parse2) + (fset 'erbp-read-line 'erbp-batch-read-line) + (fset 'erbp-dos-interface 'erbp-batch-dos-interface) + (fset 'erbp-unix-interface 'erbp-batch-unix-interface) + (erbp-mprinc "\n") + (setq erbp-batch-mode t) + (erbp-batch-loop)) + +(provide 'erbpnet) + +;;; erbpnet.el ends here diff --git a/elisp/erbot/erbrss.el b/elisp/erbot/erbrss.el new file mode 100644 index 0000000..5604026 --- /dev/null +++ b/elisp/erbot/erbrss.el @@ -0,0 +1,375 @@ +;;; erbrss.el --- Provide an RSS feed from your erbot. +;; Time-stamp: <2005-01-01 17:30:49 forcer> +;; Copyright (C) 2004 Jorgen Schaefer +;; Emacs Lisp Archive entry +;; Filename: erbrss.el +;; Package: erbrss +;; Author: Jorgen Schaefer <forcer@forcix.cx> +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot + +;;; Commentary: + +;; This extension to erbot will provide an RSS feed for your database +;; changes. Customize the erbrss group and run (erbrss-install) to +;; use. + +;;; Code: + +(defgroup erbrss nil + "RSS feeds for the erbot." + :group 'erbot) + +(defcustom erbrss-file-name "/tmp/erbot.rss" + "The file name for the RSS feed. This should be in your web +directory." + :type 'file + :group 'erbrss) + +(defcustom erbrss-rc-file-name "/tmp/erbot-rc.txt" + "The file name to store recent changes info in." + :type 'file + :group 'erbrss) + +(defcustom erbrss-max-age 604800 ; 7 days + "The number of seconds an entry in the recent changes should +stay." + :type 'integer + :group 'erbrss) + +(defcustom erbrss-item-resource-prefix "prefix://" + "The prefix for your item resources. This should be somewhere +on your webserver." + :type 'string + :group 'erbrss) + +(defcustom erbrss-rdf:about "rss about" + "The contents of the rdf:about attribute in your RSS feed." + :type 'string + :group 'erbrss) + +(defcustom erbrss-title "title" + "The title of your RSS feed." + :type 'string + :group 'erbrss) + +(defcustom erbrss-link "link" + "The link to your bots homepage, or the RSS feed, or wherever." + :type 'string + :group 'erbrss) + +(defcustom erbrss-description "description" + "The description of your RSS feed." + :type 'string + :group 'erbrss) + +(defcustom erbrss-dc:rights "rights" + "The copyright notice for your RSS feed." + :type 'string + :group 'erbrss) + +(defcustom erbrss-dc:publisher "publisher" + "The publisher of your RSS feed, i.e. you." + :type 'string + :group 'erbrss) + +(defcustom erbrss-dc:contributor "contributor" + "The contributors to your RSS feed. The users of the bot." + :type 'string + :group 'erbrss) + +(defcustom erbrss-image "image" + "A link to an image for your RSS feed." + :type 'string + :group 'erbrss) + +(defcustom erbrss-image-title "image title" + "A title for your RSS feed image." + :type 'string + :group 'erbrss) + +(defcustom erbrss-image-link "image link" + "A link for your image. This should point to your bots home page or so." + :type 'string + :group 'erbrss) + + + +;;; The erbot interface + +(defun erbrss-install () + "Initializer the RSS module of erbot." + (add-hook 'erbot-notify-add-functions 'erbrss-add) + (add-hook 'erbot-notify-forget-functions 'erbrss-forget) + (add-hook 'erbot-notify-move-functions 'erbrss-move) + (add-hook 'erbot-notify-rearrange-functions 'erbrss-rearrange) + (add-hook 'erbot-notify-substitute-functions 'erbrss-substitute) + (add-hook 'erbot-notify-merge-functions 'erbrss-merge)) + +(defun erbrss-add (nick channel term entry-num entry) + "Note an addition to the erbot database. +This is suitable for `erbot-notify-add-functions'." + (erbrss-rc-add term + (format "Added entry %i of %s: %s" entry-num term entry) + (format "%s in %s" nick channel))) + +(defun erbrss-forget (nick channel term entry-num entry remaining-entries) + "Note a removal from the erbot database. +This is suitable for `erbot-notify-forget-functions'." + (erbrss-rc-add term + (if (not (eq entry-num 'all)) + (format "Forgot entry %i of %s: %s\n\nRemaining:\n%s" + entry-num + term + entry + (mapconcat #'identity remaining-entries "\n")) + (format "Forgot %s:\n\n%s" + term + (mapconcat #'identity entry "\n"))) + (format "%s in %s" nick channel))) + +(defun erbrss-move (nick channel old-term new-term) + "Note a move within the erbot database. +This is suitable for `erbot-notify-move-functions'." + (erbrss-rc-add old-term + (format "Moved %s to %s" old-term new-term) + (format "%s in %s" nick channel))) + +(defun erbrss-rearrange (nick channel term + from-num from-entry + to-num to-entry) + "Note a rearrangement in the erbot database. +This is suitable for `erbot-notify-rearrange-functions'." + (erbrss-rc-add term + (format "Swapped entries %i and %i in term %s. Now:\n%i: %s\n%i: %s" + from-num to-num term + to-num from-entry + from-num to-entry) + (format "%s in %s" nick channel))) + +(defun erbrss-substitute (nick channel term entry-num old-entry new-entry) + "Note a substitution in the erbot database. +This is suitable for `erbot-notify-substitue-functions'." + (erbrss-rc-add term + (format "Changed entry %i of %s:\nOld: %s\nNew: %s" + entry-num term old-entry new-entry) + (format "%s in %s" nick channel))) + +(defun erbrss-merge (nick channel from-term to-term + from-entries to-entries final-entries) + "Note a merge in the erbot database. +This is suitable for `erbot-notify-merge-functions'." + (erbrss-rc-add + term + (format (concat "Merged %s into %s. New contents:\n" + "(1 means from %s, 2 from %s and + from both)\n" + "%s") + old-term new-term + old-term new-term + (erbrss-merge-description from-entries + to-entries + final-entries)) + (format "%s in %s" nick channel))) + +(defun erbrss-merge-description (from-entries to-entries final-entries) + "Return a string describing the merge. The string contains a +line per entry in FINAL-ENTRIES, prefixed with a 1 if that +entry is from FROM-ENTRIES, 2 if it is from TO-ENTRIES, and + +if it is from both." + (mapconcat (lambda (entry) + (format "%s %s" + (let ((fromp (member entry from-entries)) + (top (member entry to-entries))) + (cond + ((and fromp top) "+") + (fromp "1") + (top "2") + (t "?"))) + entry)) + final-entries + "\n")) + + +;;; Recent Changes +(defun erbrss-rc-add (term description contributor) + "Add this item to the recent changes list. +The list is managed in `erbrss-rc-file-name'." + (with-current-buffer (find-file-noselect erbrss-rc-file-name t) + (goto-char (point-min)) + (when (= (point-min) (point-max)) + (insert "()")) + (let* ((olddata (read (current-buffer))) + (newdata (erbrss-rc-remove-old + (append olddata + (list + (erbrss-make-item term + description + (current-time) + contributor)))))) + (delete-region (point-min) (point-max)) + (prin1 newdata (current-buffer)) + (let ((require-final-newline t)) + (save-buffer)) + (erbrss-regenerate-rss newdata)))) + +(defun erbrss-rc-remove-old (items) + "Remove any items from ITEMS that are older then `erbrss-max-age'." + (let ((new '())) + (while items + (when (< (- (float-time) + (float-time (erbrss-item-time (car items)))) + erbrss-max-age) + (setq new (cons (car items) + new))) + (setq items (cdr items))) + (reverse new))) + + +;;; RSS +(defun erbrss-regenerate-rss (items) + "Regenerate the RSS feed from ITEMS. +The feed is put into `erbrss-file-name'." + (with-current-buffer (find-file-noselect erbrss-file-name t) + (delete-region (point-min) (point-max)) + (erbrss-insert-rss items) + (let ((require-final-newline t)) + (save-buffer)))) + +(defun erbrss-insert-rss (items) + "Insert an RSS feed with ITEMS in it. +ITEMS should be a list of vectors, each vector having four elements: + +- Title +- Description +- Contributor +- Timestamp in seconds since the epoch" + (erbrss-sxml-insert + `((rdf:RDF (@ (xmlns:rdf "http://www.w3.org/1999/02/22-rdf-syntax-ns#") + (xmlns "http://purl.org/rss/1.0/") + (xmlns:dc "http://purl.org/dc/elements/1.1/")) + (channel (@ (rdf:about ,erbrss-rdf:about)) + (title ,erbrss-title) + (link ,erbrss-link) + (description ,erbrss-description) + (dc:rights ,erbrss-dc:rights) + (dc:date ,(erbrss-date)) + (dc:publisher ,erbrss-dc:publisher) + (dc:contributor ,erbrss-dc:contributor) + (items + (rdf:Seq + ,@(mapcar (lambda (item) + `(rdf:li (@ (rdf:resource + ,(erbrss-item-resource item))))) + items))) + (image (@ (rdf:resource ,erbrss-image)))) + + (image (@ (rdf:resource ,erbrss-image)) + (title ,erbrss-image-title) + (url ,erbrss-image) + (link ,erbrss-image-link)) + + ,@(mapcar #'erbrss-item items))))) + +(defun erbrss-item (item) + "Insert the RSS description of ITEM." + `(item (@ (rdf:about ,(erbrss-item-resource item))) + (title ,(erbrss-item-title item)) + ;(link ,(erbrss-item-resource item)) + (description ,(erbrss-item-description item)) + (dc:date ,(erbrss-date (erbrss-item-time item))) + (dc:contributor ,(erbrss-item-contributor item)))) + +(defun erbrss-make-item (title description time contributor) + "Create a new rss item entry." + (vector title description time contributor)) + +(defun erbrss-item-title (item) + "Return the title of ITEM." + (aref item 0)) + +(defun erbrss-item-description (item) + "Return the description of ITEM." + (aref item 1)) + +(defun erbrss-item-time (item) + "Return the modification time of ITEM." + (aref item 2)) + +(defun erbrss-item-contributor (item) + "Return the contributor of ITEM." + (aref item 3)) + +(defun erbrss-item-resource (item) + "Return the resource of ITEM. +This uses `erbrss-item-resource-prefix'." + (concat erbrss-item-resource-prefix + (erbrss-item-title item) + "?" (erbrss-date (erbrss-item-time item)))) + +(defun erbrss-date (&optional time) + "Return a string describing TIME, or the current time if nil." + (format-time-string "%Y-%m-%dT%H:%M:%S+00:00" + (or time + (current-time)) + t)) + + +;;; SXML + +(defun erbrss-sxml-insert (data) + "Insert an SXML data structure DATA." + (set-buffer-file-coding-system 'utf-8) + (insert "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n") + (erbrss-sxml-insert-data data)) + +(defun erbrss-sxml-insert-data (data) + "Insert a list of tags DATA as SXML." + (cond + ((stringp data) + (insert (erbrss-sxml-quote data))) + ((symbolp (car data)) + (erbrss-sxml-insert-tag data)) + (t + (mapcar #'erbrss-sxml-insert-data data)))) + +(defun erbrss-sxml-insert-tag (tag) + (let ((name (symbol-name (car tag))) + (attributes (if (and (consp (cdr tag)) + (consp (cadr tag)) + (eq '@ (caadr tag))) + (cdadr tag) + '())) + (body (if (and (consp (cdr tag)) + (consp (cadr tag)) + (eq '@ (caadr tag))) + (cddr tag) + (cdr tag)))) + (insert "<" name) + (mapcar (lambda (entry) + (insert " " + (erbrss-sxml-quote (symbol-name (car entry))) + "=\"" + (erbrss-sxml-quote (cadr entry)) + "\"")) + attributes) + (if (null body) + (insert "/>") + (insert ">") + (mapcar #'erbrss-sxml-insert-data body) + (insert "</" + (erbrss-sxml-quote name) + "\n>")))) + +(defun erbrss-sxml-quote (string) + "Quote <, > and & in STRING." + (with-temp-buffer + (mapcar (lambda (char) + (cond + ((char-equal char ?&) (insert "&")) + ((char-equal char ?<) (insert "<")) + ((char-equal char ?>) (insert ">")) + (t (insert char)))) + string) + (buffer-substring (point-min) (point-max)))) + +(provide 'erbrss) +;;; erbrss.el ends here diff --git a/elisp/erbot/erbtrain.el b/elisp/erbot/erbtrain.el new file mode 100644 index 0000000..d8f063e --- /dev/null +++ b/elisp/erbot/erbtrain.el @@ -0,0 +1,315 @@ +;;; erbtrain.el --- Train erbot (erbot).. +;; Time-stamp: <2007-11-23 11:30:00 deego> +;; Copyright (C) 2002 D. Goel +;; Emacs Lisp Archive entry +;; Filename: erbtrain.el +;; Package: erbtrain +;; Author: D. Goel <deego@gnufans.org> +;; Keywords: +;; Version: +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot +;; Thanks: Michael Olson + + +(defconst erbtrain-home-page + "http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot") + + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +;; See also: + + +;; Quick start: +(defconst erbtrain-quick-start + "Install idledo.el (tested with 0.2) and start idledo, join IRC as +yourself through ERC (tested with CVS). + +Customize erbtrain-buffer to the buffer of the channel in which you want +to train a bot. + +Create bot-parsable strings in a file. + +Then, M-x erbtrain to set up erbtrain which will then feed the strings +to the bot in that channel slowly. +" +) +(defun erbtrain-quick-start () + "Provides electric help from variable `erbtrain-quick-start'." + (interactive) + (with-electric-help + '(lambda () (insert erbtrain-quick-start) nil) "*doc*")) +(defconst erbtrain-version "NA") + +;;========================================== +;;; Requires: +(eval-when-compile (require 'cl)) +(ignore-errors (require 'idledo)) +;;; Code: + +(defgroup erbtrain nil + "The group erbtrain." + :group 'applications) +(defcustom erbtrain-before-load-hooks nil + "Hooks to run before loading erbtrain." + :group 'erbtrain) +(defcustom erbtrain-after-load-hooks nil + "Hooks to run after loading erbtrain." + :group 'erbtrain) +(run-hooks 'erbtrain-before-load-hooks) + + +;;; Real Code: + +(defcustom erbtrain-buffer "#fsbot" + "" + :group 'erbtrain) + +(defvar erbtrain-list nil) + +(defvar erbtrain-idledo-interval-small 2) +(defvar erbtrain-idledo-interval 120) +(defvar erbtrain-idledo-interval-subsequent 10) + +;;;###autoload +(defun erbtrain-file-through-irc (file) + (interactive "f") + (setq idledo-interval-small erbtrain-idledo-interval-small) + (setq idledo-interval erbtrain-idledo-interval) + (setq idledo-interval-subsequent erbtrain-idledo-interval-subsequent) + (save-window-excursion + (find-file file) + (let ((allstrings (buffer-substring-no-properties + (point-min) (point-max)))) + (setq allstrings (split-string allstrings "\n")) + (setq erbtrain-list allstrings) + (erbtrain-resume)))) + +;;;###autoload +(defalias 'erbtrain-file 'erbtrain-file-through-irc) + + +(defvar erbtrain-local-buffer "*erbtrain-log*") + +(defun erbtrain-file-locally (file) + "EXPERIMENTAL. Can use this when you ARE su'ed so that you are in the bot's account. + +su to your bot's account and then use this... This has the minor +advantage of being much faster. " + (interactive "f") + (unless + (yes-or-no-p + (concat "Are you really logged in as the bot? ")) + (error "Please use M-x erbtrain-file instead. ")) + (save-window-excursion + (find-file file) + (let ((allstrings (buffer-substring-no-properties + (point-min) (point-max)))) + (setq allstrings (split-string allstrings "\n")) + (mapcar 'erbtrain-local allstrings))) + (display-buffer erbtrain-local-buffer)) + + +(defun erbtrain-local (str) + "See the doc for erbtrain-file-locally. " + ;;(require 'erball) + (let* ((strlisp1 (ignore-errors (fs-parse str))) + (strlisp (ignore-errors + (if (stringp strlisp1) + (erbn-read strlisp1) nil))) + (result (ignore-errors (fs-eval strlisp)))) + (erbtrain-local-log str strlisp result))) + +(defun erbtrain-local-log (str expr result) + (save-excursion + (set-buffer (get-buffer-create erbtrain-local-buffer)) + (goto-char (point-max)) + (insert "\n") + (let ((msg (concat str "\n" "=> " (format "%S" expr) "\n" "==> " + (format "%S" result) "\n\n"))) + (message "%s" msg) + (insert msg)))) + + + + +(defun erbtrain-resume () + (interactive) + (let* ((len (length erbtrain-list)) + (toolongp (> len 3000)) + ls) + (if toolongp + (progn + (setq ls (subseq erbtrain-list 0 3001)) + (setq erbtrain-list (subseq erbtrain-list 3001))) + (setq ls erbtrain-list) + (setq erbtrain-list nil) + ) + (when toolongp + (y-or-n-p + (format "Too LOONG list (%S). Type M-x erbtrain-resume later. ok?" + len))) + (mapcar + 'erbtrain-idle + (cons + ;; so that we prevent duplicate entries. + ;; this should already be the default, but just to ensure.. + ", (fs-set-add-all-disable)" + ls + ;;(list ", (fs-set-add-all-disable)") + )) + (message "Added %S idledo's" (length ls)))) + + +(defun erbtrain-idle (str) + "sets up a string to idly fed to the bot.." + (idledo-add-action-at-end + `(erbtrain ,str))) + +(defun erbtrain-idle-now (str) + "sets up a string to idly fed to the bot.." + (idledo-add-action + `(erbtrain ,str))) + + +(defun erbtrain-buggy (str) + (delete-other-windows) + (let ((buf ;;(buffer-name) + (window-buffer))) + (display-buffer erbtrain-buffer) + (let ((win (get-buffer-window erbtrain-buffer))) + (if win (select-window win) + (switch-to-buffer erbtrain-buffer))) + (goto-char (point-max)) + (insert str) + (erc-send-current-line) + (let ((bufwindow (get-buffer-window buf))) + (if bufwindow + (select-window bufwindow) + (switch-to-buffer buf))))) + + + +;;; 2003-01-13 T17:26:24-0500 (Monday) D. Goel +;;;###autoload +(defun erbtrain (str) + (delete-other-windows) + (let ((buf (get-buffer erbtrain-buffer))) + (cond + (buf + (switch-to-buffer buf) + (goto-char (point-max)) + (insert str) + (erc-send-current-line)) + (t + (beep) + (message "No buffer! Trying to recreate the idledo. ") + (sit-for 0.3) + (idledo-add-action + `(erbtrain ,str)))))) + + +;;;==================================================== +;; OT: the foll. has nothing to do with training the bot, but is a way to +;; keep ERC connection alive: + +;(defvar erbtrain-keep-alive-string +; "/ping #fsbot") + +;;;###autoload +(defcustom erbtrain-keep-alive-p t + "" + :group 'erbtrain) + + +;;; (defun erbtrain-keep-alive-kick-once-old () +;;; (interactive) +;;; (let ((erc-flood-protect nil)) +;;; (save-window-excursion +;;; (when erbtrain-keep-alive-p +;;; (erbtrain erbtrain-keep-alive-string))))) + +(defvar erbtrain-keep-alive-buffer "#somechannel") + + + +;;; 2003-02-05 T13:22:11-0500 (Wednesday) D. Goel +;; should do it like this: +;; <delYsid> (erc-with-all-buffers-of-server nil #'erc-server-buffer-p +;; (lambda () \...)) + +(defun erbtrain-keep-alive-kick-once () + (interactive) + (let ((erc-flood-protect nil)) + (mapcar + (lambda (arg) + (save-window-excursion + (let ((bufname (buffer-name-p-my arg))) + (when bufname + (switch-to-buffer arg) + ;;(erc-cmd-PING "nickserv") + (when (erc-process-alive) (erc-send-command "PING")))))) + (if (listp erbtrain-keep-alive-buffer) erbtrain-keep-alive-buffer + (list erbtrain-keep-alive-buffer))))) + +(defvar erbtrain-keep-alive-timer nil) + +;;;###autoload +(defun erbtrain-keep-alive () + (interactive) + ;;(idledo-nullify) + (setq erbtrain-keep-alive-timer + (run-with-timer 30 + 10 + 'erbtrain-keep-alive-kick-once)) + ;;(setq erbtrain-keep-alive-active-p + ;;t) + + (message "Started erbtrain-keep-alive. ")) + + +;;;==================================================== + +(defun erbtrain-utils-teach-acronyms (&optional botstring) + "Teach the the bot from BOTSTRING some acronyms. +You will need wtf.el (from the contrib directory) for this +function to work. +See also the new function fs-wtf. +Don't forget to connect to irc before running this function." + (interactive) + (idledo-nullify) + (require 'wtf) + (unless botstring (setq botstring ", ")) + (setq erbtrain-list + (mapcar #'(lambda (ref) + (concat botstring (car ref) + " is short for " + (upcase-initials (cdr ref)))) + wtf-alist)) + (erbtrain-resume) + (ignore-errors (idledo-start))) + + +(provide 'erbtrain) +(run-hooks 'erbtrain-after-load-hooks) + + + +;;; erbtrain.el ends here diff --git a/elisp/erbot/erbtranslate.el b/elisp/erbot/erbtranslate.el new file mode 100644 index 0000000..a12dcd7 --- /dev/null +++ b/elisp/erbot/erbtranslate.el @@ -0,0 +1,139 @@ +;;; erbtranslate.el --- Natural Language translation functions. +;; Time-stamp: <2009-09-26 22:33:14 fledermaus> +;; Copyright © 2002 Alejandro Benitez +;; Emacs Lisp Archive entry +;; Filename: erbtranslate.el +;; Package: erbot +;; Authors: Alejandro Benitez <benitezalejandrogm@gmail.com>, +;; Vivek Dasmohapatra <vivek@etla.org> +;; Deepak Goel <deego@gnufans.org> +;; Maintainer: Vivek Dasmohapatra <vivek@etla.org> +;; Version: 0.1DEV +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;; You need to install libtranslate for this to work. The binary, +;; translate-bin, is provided, for example in Ubuntu Dapper: +;; http://packages.ubuntu.com/dapper/libs/libtranslate-bin +;; See also: + +(defvar erbtranslate-version "0.1dev") + +(require 'translate) + +(defun erbtranslate-enabled-check () + (erbutils-enabled-check erbn-translate-p)) + +(defalias 'fsi-t8 'fsi-translate) + +(defcustom erbn-translate-p nil + "Enabling this should be completely safe. We do use call-process +here whenever passing any arguments to external commands.") + +(defun fsi-translate (&optional from to &rest text) + (erbtranslate-enabled-check) + (if (not (and from to text)) + (let ((frame (backtrace-frame 3)) (caller nil)) + (setq caller (symbol-name (cadr frame)) + caller (replace-regexp-in-string "^\\w+-" "" caller)) + (format "Usage: ,%s FROM TO TEXT" caller)) + (setq text (mapconcat #'(lambda (arg) (format "%s" arg)) text " ") + from (format "%s" from) + to (format "%s" to )) + (condition-case caught + (translate from to text) + (error (concat "libtranslate error:" (cdr caught)) )) )) + +(defalias 'fsi-t8-l 'fsi-translate-list-pairs) + +(defun fsi-translate-list-pairs (&optional from to &rest args) + "Allow the user to search for translation pairs. Only gives counts +unless both from and to are specified. *, any, - are allowed as wildcards." + (erbtranslate-enabled-check) + (let ((pair-data)) + (setq from (format "%s" (or from "*")) + to (format "%s" (or to "*")) + pair-data (translate-list-pairs from to)) + (if (string-match "^\\(?:\*\\|any\\|-\\|\\)$" from) (setq from nil)) + (if (string-match "^\\(?:\*\\|any\\|-\\|\\)$" to ) (setq to nil)) + (cond + ( (and (not from) (not to)) ;; neither end point specified + (concat + (format "%d language pair(s) available.\n" (length pair-data)) + "Specify an origin and/or destination language to see a list:\n" + " translate-list-pairs es ja\n" + " translate-list-pairs castilian\n" + " translate-list-pairs * zh-TW\n") ) + ( (or (not to) (not from)) ;; one end point specified + (let ( (dir (if from "From" "To")) + (op (if from 'cadr 'car)) + (s nil) + (x (length pair-data)) + (fl (format "%s" (or from to))) ) + (setq s (mapcar (lambda (p) (car (funcall op p))) pair-data) + fl (or (translate-full-name fl) fl)) + (apply 'concat + (format "%s %s: %d language(s) available.\n" dir fl x) + (if (<= (length s) 100) + (list + (mapconcat + (lambda (x) (translate-full-name x)) s ", ")) ))) ) + (t ;; fully spec'd translation + (let ( (x (length pair-data)) ) + (setq from (or (translate-full-name from) from) + to (or (translate-full-name to ) to )) + (apply 'concat + (format "%s -> %s: %d pair(s) available.\n" from to x) + (mapcar (lambda (x) + (format "%s -> %s\n" + (princ (car x)) + (princ (cadr x)))) pair-data)) )) ) )) + +(defalias 'fsi-t8-s 'fsi-translate-list-services) + +(defun fsi-translate-list-services (&rest args) + (erbtranslate-enabled-check) + (erbn-shell-command-to-string + (concat translate-program " --list-services") + '(t))) + +(defun fsi-kks (&rest nihongo) + (let ( (coding-system-for-read 'euc-jp) + (coding-system-for-write 'euc-jp) + (text (mapconcat #'(lambda (x) (format "%s" x)) nihongo " ")) ) + (with-temp-buffer + (insert text) + (shell-command-on-region + (point-min) (point-max) + "kakasi -i euc -Ha -Ka -Ja -Ea -ka -s | sed 's/ESC<2E>.//g'" nil t) + (buffer-string)) )) +;; temporarily disabled till clean support is provided by translate.el + +;; (defun fsi-translate-web-page (from to url &rest args) +;; (erbtranslate-enabled-check) +;; (shsp (list erbn-translate-program +;; "-f" +;; (format "%s" from) "-t" +;; (format "%s" to) +;; (format "%s" url)))) + +;; (defalias 'fsi-t8-w 'fsi-translate-web-page) + +(provide 'erbtranslate) +;;; erbtranslate.el ends here diff --git a/elisp/erbot/erbunlisp.el b/elisp/erbot/erbunlisp.el new file mode 100644 index 0000000..9ad196a --- /dev/null +++ b/elisp/erbot/erbunlisp.el @@ -0,0 +1,90 @@ +;;; erbunlisp.el --- Help Simplify functions for nonlisp channels. +;; Time-stamp: <2007-11-23 11:29:47 deego> +;; Copyright (C) 2003 D. Goel +;; Emacs Lisp Archive entry +;; Filename: erbunlisp.el +;; Package: erbunlisp +;; Author: D. Goel <deego@gnufans.org> +;; Keywords: +;; Version: +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot + + +(defconst erbunlisp-home-page + "http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot") + + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +(defconst erbunlisp-version "0.0dev") + +;;========================================== +;;; Requires: +(eval-when-compile (require 'cl)) + +;;; Code: + +(defgroup erbunlisp nil + "The group erbunlisp." + :group 'applications) +(defcustom erbunlisp-before-load-hooks nil + "Hooks to run before loading erbunlisp." + :group 'erbunlisp) +(defcustom erbunlisp-after-load-hooks nil + "Hooks to run after loading erbunlisp." + :group 'erbunlisp) +(run-hooks 'erbunlisp-before-load-hooks) + + + +;;; Real Code: + +(defcustom erbunlisp-list + '((fs-remove fs-forget remove)) + "When you type erbunlisp-install, the first entries will get aliased +to second one. +When you type erbunlisp-uninstall, the first entries will get aliased +to the third one. " + :group 'erbunlisp) + + + +(defun erbunlisp-install () + (interactive) + (mapcar + (lambda (arg) + (defalias (first arg) + (second arg))) + erbunlisp-list)) + +(defun erbunlisp-uninstall () + (interactive) + (mapcar + (lambda (arg) + (defalias (first arg) (third arg))) + erbunlisp-list)) + + +(provide 'erbunlisp) +(run-hooks 'erbunlisp-after-load-hooks) + + + +;;; erbunlisp.el ends here diff --git a/elisp/erbot/erburl.el b/elisp/erbot/erburl.el new file mode 100644 index 0000000..4995b45 --- /dev/null +++ b/elisp/erbot/erburl.el @@ -0,0 +1,219 @@ +;;; erburl.el --- Learn terms from a url. +;; Time-stamp: +;; Copyright (C) 2004 Pete Kazmier +;; Emacs Lisp Archive entry +;; Filename: erburl.el +;; Package: erburl +;; Author: Pete Kazmier <pete-erbot-dev@kazmier.com> +;; Keywords: +;; Version: +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot + +(defconst erbtrain-home-page + "http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot") + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +;; See also: + + +;; Quick start: +(defconst erburl-quick-start + "This library enables one to add and remove entries to your bot's +bbdb that have been \"scraped\" from sources on the web. When using +this library, you must be running under the uid of your bot. In +addition, (although I'm not positive), you should make sure that only +one instance of your bot is running to avoid clobbering the bbdb. I +use this library in the emacs session of my running bot. Although the +main function of this library is asynchronous, when adding a lot of +terms, the local session is not really useable (you see the progress +though), however the bot still responds to requests from its channels. + +With that all said, lets add the terms from a wiki using the wiki page +name as the term. The note attached to the term will be a string in +the form of \"at URL\" where URL is the URL to the page: + + (erburl-scrape-terms + \"http://www.emacswiki.org/cgi-bin/wiki?action=index\") + +This library can be used to add terms from any web page because you +can pass your own parser to ERBURL-SCRAPE-TERMS (see the doc string +for the full details). This includes parsing pages and adding notes +that contain information other than a simple link back to the original +page. + +The library also includes a function to remove all entries that +contain a specific URL in the notes of an entry. It will only remove +the term in its entirety if it does not contain other notes for the +same term. It should be noted that this function is not asynchronous +and will cause your bot to stop responding on channels if it is +deleting a large number of records. + +Finally, for an additional reference to using this library, please see +erbjavadoc which uses this library to provide a command that will +permit users to add javadoc entries from a set of javadoc pages. +" + ) + +(defun erburl-quick-start () + "Provides electric help from variable `erburl-quick-start'." + (interactive) + (with-electric-help + '(lambda () (insert erburl-quick-start) nil) "*doc*")) + +(defconst erburl-version "0.0dev") + +;;========================================== +;;; Requires: +(require 'cl) +(require 'url) + +;;; Code: + +(defgroup erburl nil + "The group erburl." + :group 'applications) + +(defcustom erburl-before-load-hooks nil + "Hooks to run before loading erburl." + :group 'erburl) + +(defcustom erburl-after-load-hooks nil + "Hooks to run after loading erburl." + :group 'erburl) + +(run-hooks 'erburl-before-load-hooks) + +;;; Real Code: + + +(defun erburl-scrape-terms (url &optional entry-parser-fn progress-callback cbargs) + "Scrape terms from URL using the ENTRY-PARSER-FN and add them to the +erbot's botbbdb. Due to the asynchronous nature of this call, messages +are sent to PROGRESS-CALLBACK to report process. + +ENTRY-PARSER-FN is called when the contents of the URL have finished +downloading into a buffer. The contents of the buffer include any +headers that were sent followed by a blank line and then followed by +the actual contents of the URL. When ENTRY-PARSER-FN is called, this +buffer has already been selected. ENTRY-PARSER-FN is passed CBARGS as +arguments, and must return a list of entries to be added to the bbdb. +Each entry should be a list of two elements with the term as the first +element and the definition as the second. The default parser used if +one is not specified is ERBURL-HREF-PARSER (which parses href links). + +PROGRESS-CALLBACK is called once after the entries have been added to +the bbdb with a descriptive message indicating how many terms were +added. It may also be called after the entries have been parsed with +a message indicating that it will take a significant amount of time to +add the entries to the bbdb. When PROGRESS-CALLBACK is called, it is +passed a message as the first argument and then CBARGS are passed as +additional arguments. The default callback used if one is not +specified is MESSAGE. + +CBARGS are passed as additional argements to both of the callback +functions. +" + (let ((parser (or entry-parser-fn 'erburl-href-parser)) + (progress (or progress-callback 'message))) + (url-retrieve url + 'erburl-scrape-callback + (list url parser progress cbargs)))) + +(defun erburl-scrape-callback (url entry-parser-fn progress-callback cbargs) + "Callback invoked by url-retrieve. It is invoked in the buffer with +the contents of the retrieved URL. In addition, this method is passed +two additional callbacks to assist during processing (please refer to +erburl-scrape-terms doc). Finally, CBARGS is a list of arguments that +will be passed as additional arguments to the callback functions (I +wish elisp supported lexical closures!)" + (goto-char (point-min)) + (let* ((buffer (current-buffer)) + (count 0) + (entries (apply entry-parser-fn cbargs)) + (delay 0.1) + (total (length entries)) + (eta (* total delay))) + (when (> eta 10) + (apply progress-callback + (format "Processing %d entries from %s will take at least %.1f minutes ..." + total url (/ eta 60)) + cbargs)) + (erbot-working + (dolist (entry entries) + (message "Adding entry for %s" (first entry)) + (sleep-for 0.1) + ;; I need to find a way to speed this up. As the bbdb gets + ;; larger things really start to slow down significantly. + (when (or (ignore-errors (apply 'fs-set-also entry)) + (ignore-errors (apply 'fs-set-term entry))) + (incf count)))) + (erbbdb-save) + (apply progress-callback + (format "Added %d entries from %s." count url) + cbargs) + (kill-buffer buffer))) + +;; This needs to be asynchronous if we are to make an fsi-* version +;; for IRC users to execute because this function is very slow when +;; removing a large number of entries from the bbdb. +(defun erburl-forget-terms (url) + "Remove all terms and entries for the specified URL. This will +remove terms from the bbdb entirely unless a particular term has more +than one entry, in which case, only the relevant entry is removed. +Note: this function is not asynchronous and will cause your bot to +stop responding on channels if it is removing a large number of +entries that match the specified URL." + (unless (string-match "^https?://[^/]+/" url) + (error "The specified URL is not well-formed")) + (let ((count 0) + (regexp (regexp-quote url)) + (erbforget-interactivity -100)) + (erbot-working + (setq count (erbforget-sw regexp nil t))) + (erbbdb-save) + count)) + +(defun erburl-href-parser (&optional base terms-with-spaces-p) + "Returns a list of lists representing the HTML links in the current +buffer. Each list is composed of a term and a string indicating the +link which is prefixed with BASE if supplied. If TERMS-WITH-SPACES-P +is non-nil, only links with single word text will be included." + (let ((entries '()) + (case-fold-search t)) + (while (re-search-forward + (if terms-with-spaces-p + "<a .*?href=\"\\([^\"]+\\)\".*?>\\(?:<[^>]+>\\)*\\([^ <]+\\)\\(?:<[^>]+>\\)*</a>" + "<a .*?href=\"\\([^\"]+\\)\".*?>\\(?:<[^>]+>\\)*\\([^<]+\\)\\(?:<[^>]+>\\)*</a>") + nil t) + (push (list (match-string 2) + (concat "at " + (when base (concat base "/")) + (match-string 1))) + entries)) + entries)) + +(defun erburl-safe-url (url) + ) + +(provide 'erburl) +(run-hooks 'erburl-after-load-hooks) + +;;; erburl.el ends here diff --git a/elisp/erbot/erbutils.el b/elisp/erbot/erbutils.el new file mode 100644 index 0000000..72682b8 --- /dev/null +++ b/elisp/erbot/erbutils.el @@ -0,0 +1,660 @@ +;;; erbutils.el --- +;; Time-stamp: <2007-11-23 11:29:44 deego> +;; Copyright (C) 2002,2003,2004,2005 D. Goel +;; Emacs Lisp Archive entry +;; Filename: erbutils.el +;; Package: erbutils +;; Author: D. Goel <deego@gnufans.org> +;; Version: 0.0dev +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot + + +(defvar erbutils-home-page + "http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot") + + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +(defvar erbutils-version "0.0dev") + +;;========================================== +;;; Code: +(require 'rot13) + +(defgroup erbutils nil + "The group erbutils" + :group 'applications) +(defcustom erbutils-before-load-hooks nil "" :group 'erbutils) +(defcustom erbutils-after-load-hooks nil "" :group 'erbutils) +(run-hooks 'erbutils-before-load-hooks) + + +(defalias 'erbutils-stringize 'erbutils-stringify) +;; should please not eval anyting... since called by erbc.. + +(defun erbutils-stringify (msg-list) + (if (stringp msg-list) + msg-list + (mapconcat + '(lambda (arg) + (if (stringp arg) arg + (format "%s" arg))) + msg-list " " ))) + + +(defun erbutils-string= (foo bar &optional ignore-case) + (and foo bar + (if ignore-case + (string= (downcase foo) (downcase bar)) + (string= foo bar)))) + + +(defun erbutils-errors-toggle () + (interactive) + (setq erbutils-ignore-errors-p + (not erbutils-ignore-errors-p)) + (message "erbutils-ignore-errors-p set to %s" + erbutils-ignore-errors-p)) + + +(defvar erbutils-ignore-errors-p t) +(defmacro erbutils-ignore-errors (&rest body) + "DOES NOT return nil, unlike ignore-errors.." + (let ((err (gensym))) + `(condition-case ,err (progn ,@body) + (error + (progn + ;(ding t) + ;(ding t) + ;;(message "ERROR: %s" (error-message-string ,err)) + ;;(sit-for 1) + (ding t) + (unless erbutils-ignore-errors-p + (error (error-message-string ,err))) + (unless fs-found-query-p + (erbutils-error + "%s" + (fs-limit-lines + (error-message-string ,err))))))))) + +(defvar erbutils-error-debug-p nil + "Turn on for debugging.." + ) +(defun erbutils-error (&rest args) + (cond + (erbutils-error-debug-p (apply 'error args)) + (t + (unless args (error + (format "Syntax: , (fs-error msg &rest format-args)"))) + (let* ((main + (erbutils-random + '("oops, error. %s" + ;;"Blue Screen: %s" + "BEEEP: %s" + "ERROR: %s" + "err..%s" + ":( %s" + "Doh! %s" + "Oh sh**! %s" + "Nooo! %s" + "oops, %s" + "Uh oh, %s" + "whoops, %s" + ))) + (result + (format main + (apply 'format args)))) + (or + (ignore-errors + (fs-h4x0r-maybe + (fs-studlify-maybe + result))) + result))))) + + + +(defun erbutils-matching-functions (string) + "returns all functions that start with string" + (apropos-internal (concat "^" (regexp-quote string)) + 'fboundp) + + ;; (let* ((results nil) +;;; (len (- (length obarray) 1)) +;;; (ctr 0)) +;;; (while (< ctr len) +;;; (incf ctr) +;;; (if (and +;;; (equal (string-match string (format "%s" (aref obarray +;;; ctr))) +;;; 0) +;;; (fboundp (aref obarray ctr)) +;;; ) +;;; (push (aref obarray ctr) results))) +;;; results) +) + + + + + + (defun erbutils-quote-list (ls) + "ls is, in general, a tree... + + We will make sure here that each element of the tree that is a symbol gets + quoted... + + + " + (mapcar '(lambda (arg) + (list 'quote arg)) + ls)) + +(defun erbutils-random (list &optional weights) + "Return a random element from list. +Optional WEIGHTS are relative. They should be integers. +example: (erbutils-random '(a b c) '(1 1 2)) should return c twice +as many times as it returns a... +" + (cond + ((null weights) + (nth (random (length list)) list)) + (t + (let* ((len (length list)) + (revw (reverse weights)) + (fir (car revw)) + ) + ;; If weights are partially specified, fill in missing entries. + (while (< (length revw) len) + (setq revw (cons fir revw))) + (setq weights (reverse revw)) + (let* ((total (apply '+ weights)) + (choice (random total)) + (curw weights) + (ctr 0) + (num 0)) + + (while (>= choice (+ ctr (car curw))) + (setq ctr (+ ctr (car curw))) + (incf num) + (setq curw (cdr curw))) + (nth num list)))))) + + + +(defun erbutils-describe-variable (&optional variable buffer) + "Like describe-variable, but doesn't print the actual value.." + (unless (bufferp buffer) (setq buffer (current-buffer))) + (if (not (symbolp variable)) + (message "Unknown variable or You did not specify a variable") + (let (valvoid) + (with-current-buffer buffer + (with-output-to-temp-buffer "*Help*" + (terpri) + (if (erbcompat-local-variable-p variable) + (progn + (princ (format "Local in buffer %s; " (buffer-name))) + + (terpri))) + (terpri) + (let ((doc + (documentation-property variable 'variable-documentation))) + (princ (or doc "not documented as a variable."))) + (help-setup-xref (list #'describe-variable variable (current-buffer)) + (interactive-p)) + + ;; Make a link to customize if this variable can be customized. + ;; Note, it is not reliable to test only for a custom-type property + ;; because those are only present after the var's definition + ;; has been loaded. + (if (or (get variable 'custom-type) ; after defcustom + (get variable 'custom-loads) ; from loaddefs.el + (get variable 'standard-value)) ; from cus-start.el + (let ((customize-label "customize")) + (terpri) + (terpri) + (princ (concat "You can " customize-label " this variable.")) + (with-current-buffer "*Help*" + (save-excursion + (re-search-backward + (concat "\\(" customize-label "\\)") nil t) + (if (> 22 emacs-major-version) + (help-xref-button 1 (lambda (v) + (if help-xref-stack + (pop help-xref-stack)) + (customize-variable v)) + variable + "mouse-2, RET: customize variable") + (help-xref-button 1 'help-customize-variable variable)) + )))) + ;; Make a hyperlink to the library if appropriate. (Don't + ;; change the format of the buffer's initial line in case + ;; anything expects the current format.) + (let ((file-name (symbol-file variable))) + (when file-name + (princ "\n\nDefined in `") + (princ file-name) + (princ "'.") + (with-current-buffer "*Help*" + (save-excursion + (re-search-backward "`\\([^`']+\\)'" nil t) + (if (> 22 emacs-major-version) + (help-xref-button + 1 (lambda (arg) + (let ((location + (find-variable-noselect arg))) + (pop-to-buffer (car location)) + (goto-char (cdr location)))) + variable "mouse-2, RET: find variable's definition") + (help-xref-button 1 'help-variable-def variable file-name)) + )))) + + (print-help-return-message) + (save-excursion + (set-buffer standard-output) + ;; Return the text we displayed. + (buffer-substring-no-properties (point-min) (point-max)))))))) + + +(defvar erbutils-itemize-style + (list "[%s] %s\n\n" "[%s] %s\n\n" "[%s] %s,\n\n") + + "Another good choice, for example, and used by petekaz's petebot, is + \(list \"[%s] %s,\n\n\" \"and also [%s] %s\n\n\" \"and [%s] %s,\n\n\") +") + +(defun erbutils-itemize (result &optional N shortenedp style) + (unless style (setq style erbutils-itemize-style)) + (unless (integerp N) (setq N 0)) + (let + ((st1 (first style)) + (st2 (second style)) + (st3 (third style)) + (ctr N) + (rem result) + (sofar "")) + (if (equal (length result) 1) + (setq sofar (format "%s" (car result))) + (while rem + (setq sofar + (concat + sofar + (format + (cond + ((= ctr 0) + st1) + ((null (rest rem)) + st2) + (t st3)) + ctr + (car rem)))) + (setq ctr (+ ctr 1)) + (setq rem (cdr rem)))) + (when shortenedp + (setq sofar (concat sofar " .. + other entries"))) + sofar)) + + + +(defun erbutils-function-minus-doc (fstr &rest ignore) + "fstr is the string containing the function" + (let* ((fdoc (if (stringp fstr) fstr (format "%s" fstr))) + newdoc) + (setq newdoc + (with-temp-buffer + (insert fdoc) + (goto-char (point-min)) + (search-forward "(" nil t) + (forward-sexp 4) + (if (stringp (sexp-at-point)) + ;; this sets mark.. bad programming, i know.. + (backward-kill-sexp 1)) + (erbutils-buffer-string))) + (erbutils-single-lines newdoc))) + +(defun erbutils-single-lines (str) + "Eliminates all \n or lines comprising entirely of whitespace" + (mapconcat + 'identity + (delete-if + (lambda (str) + (string-match "^[ \t]*$" str)) + (split-string str + "\n")) + "\n")) + +(defun erbutils-cleanup-whitespace (str) + "Strip all leading whitespace and replace one or more tabs, newlines, +or spaces with a single space." + (let ((result (replace-regexp-in-string "[\t\n ]+" " " str))) + (subseq result (or (position ? result :test-not 'eq) 0)))) + +(defun erbutils-downcase (str) + (if (stringp str) + (downcase str) + str)) + + + + + + +(defun erbutils-add-nick (msg) + (if + (and (not fs-found-query-p) + (not fs-internal-directed) + (> (random 100) 30) + (stringp msg)) + (eval + (erbutils-random + '( + ;;(concat msg ", " fs-nick) + (concat fs-nick ": " msg) + (concat fs-nick ", " msg) + ) + '(1 1 ))) + msg)) + + +(defun erbutils-add-nick-maybe (msg) + (eval + (erbutils-random + '((erbutils-add-nick msg) + msg) + fs-internal-add-nick-weights + ))) + + +(defun erbutils-convert-sequence (arg) + (if (sequencep arg) + arg + (format "%s" arg))) + + +(defvar erbutils-eval-until-limited-length 70) +(defun erbutils-eval-until-limited (expr) + (let + ((ans nil) (donep nil)) + (while (not donep) + (setq ans + (eval expr)) + (setq donep (<= (length (format "%s" ans)) + erbutils-eval-until-limited-length))) + ans)) + + + +(defun erbutils-replace-strings-in-string (froms tos str &rest + args) + (let ((st str)) + (mapcar* + (lambda (a b) + (setq st (apply 'erbutils-replace-string-in-string + a b st args))) + froms tos) + st)) + +;;;###autoload +(if (featurep 'xemacs) + (defun erbutils-replace-string-in-string (from to string &optional + delimited start end) + (save-excursion + (with-temp-buffer + (insert string) + (save-restriction + (narrow-to-region (or start (point-min)) (or end (point-max))) + (goto-char (point-min)) + (replace-string from to delimited)) + (buffer-substring-no-properties (point-min) (point-max))))) + (defun erbutils-replace-string-in-string (from to string &optional + delimited start end) + (save-excursion + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (replace-string from to delimited start end) + (buffer-substring-no-properties (point-min) (point-max)))))) + +(defun erbutils-sublist-p (a b &optional start) + "tells if list a is a member of list b. If start is true, the match +should start at the beginning of b." + (cond + ((null a) t) + ((null b) nil) + (start (and + (equal (car a) (car b)) + (erbutils-sublist-p (cdr a) (cdr b) t))) + (t + (let ((foo (member (car a) b))) + (and foo + (or + (erbutils-sublist-p (cdr a) (cdr foo) t) + (erbutils-sublist-p a (cdr foo)))))))) + +;;;###autoload +(defun erbutils-flatten (tree) + (cond + ((null tree) nil) + ((listp tree) (apply 'append + (mapcar 'erbutils-flatten tree))) + (t (list tree)))) + +(provide 'erbutils) +(run-hooks 'erbutils-after-load-hooks) + + +(defun erbutils-remove-text-properties (str1) +;;; (with-temp-buffer +;;; (insert text) +;;; (buffer-substring-no-properties (point-min) (point-max)))) + ;; fledermaus' code: avoid with-temp-buffer becuse of i8n problems. + (let ((str (copy-sequence str1))) + (set-text-properties 0 (length str) nil str) + str)) + + + +(defun erbutils-defalias-i (ls &optional prefix prefix-rm + functionpref) + "Similar to erbutils-defalias, except that for functions, it +defaliases a 'fsi-" + (unless functionpref (setq functionpref "fsi-")) + (erbutils-defalias ls prefix prefix-rm functionpref)) + + +(defun erbutils-defalias (ls &optional prefix prefix-rm functionpref) + "Define new fs- aliases from ls. + +If the entry in the ls is a function, it is defaliased. If it is a +variable, we define a new function, that will return the value of the +variable. + +When prefix and prefix-rm is provided, we assume that the entry is of +the form prefix-rmENTRY. And we then (defalias fs-prefixENTRY +prefix-rmENTRY. + +functionpref should usually be fs-. If you want fsi- instead, you +might prefer calling erbutils-defalias-i instead. +" + (unless functionpref (setq functionpref "fs-")) + (let* ((pref (if prefix (format "%s" prefix) "")) + (pref-rm (if prefix-rm (format "%s" prefix-rm) "")) + (lenrm (length pref-rm)) + (reg (concat "^" (regexp-quote pref-rm)))) + (mapcar + (lambda (arg) + (let* ( + (argst (format "%s" arg)) + (gop (string-match reg argst)) + (arg2 (and gop (substring argst lenrm))) + (foo (and gop (intern (format (concat functionpref "%s%s") + pref arg2))))) + + (when gop + (if (functionp arg) + (defalias foo arg) + (erbutils-defalias-vars (list arg prefix prefix-rm)) + ;;`(defun ,foo () + ;; ,(concat "Pseudo function that returns the value of `" + ;; argst "'. ") + ;;,arg) + )))) + ls))) + +(defun erbutils-defalias-vars (ls &optional prefix prefix-rm) + (let* ((pref (if prefix (format "%s" prefix) "")) + (pref-rm (if prefix-rm (format "%s" prefix-rm) "")) + (lenrm (length pref-rm)) + (reg (concat "^" (regexp-quote pref-rm)))) + (mapcar + (lambda (arg) + (let* ( + (argst (format "%s" arg)) + (gop (string-match reg argst)) + (arg2 (and gop (substring argst lenrm))) + (foo (and gop (intern (format "fs-%s%s" pref arg2))))) + + (when gop + (eval + `(defun ,foo () + ,(concat "Pseudo function that returns the value of `" + argst "'. ") + ,arg))))) + ls))) + + +(defun erbutils-region-to-string (fcn &rest str) + (with-temp-buffer + (while str + (let ((aa (car str))) + (when aa + (insert (format "%s " aa)))) + (pop str)) + (goto-char (point-min)) + (funcall fcn (point-min) (point-max)) + (buffer-substring-no-properties (point-min) (point-max)))) + + +(defun erbutils-rot13 (str) + (apply + 'string + (mapcar + (lambda (i) + (let ((foo (aref rot13-display-table i))) + (if foo (aref foo 0) i))) + str))) + +(defun erbutils-file-contents (file) + (cond + ((not (file-exists-p file)) + "") + (t + (with-temp-buffer + (insert-file-contents file) + (buffer-substring-no-properties (point-min) (point-max)))))) + + +(defun erbutils-file-sexps (file) + (let ((str (erbutils-file-contents file)) + expr) + (and + (stringp str) + (not (string= str "")) + (setq expr (erbn-read (concat " ( " str " )")))))) + + +(defun erbutils-functions-in-file (file) + "Returns the list of functions in the file. File should be a valid +lisp file, else error. " + (let ((str (erbutils-file-contents file)) + expr) + (and + (stringp str) + (not (string= str "")) + (setq expr (erbn-read (concat " ( " str " )"))) + (ignore-errors (mapcar 'second expr))))) + + + +(defun erbutils-mkback-maybe (file) + (ignore-errors (require 'mkback)) + (ignore-errors + (let ((mkback-interactivity -100)) + (mkback file)))) + + +(defun erbutils-listp-proper (l) + "from <Riastradh>" + (or (null l) (and (consp l) + (erbutils-listp-proper (cdr l))))) + + +(defun erbutils-html-url-p (str) + "Guesses if the string is a url that will yield HTML content. +Basically, look for any url that doesn't have any extension or +one that has .html, .shtml, or .htm. Returns the str if it is +a valid url that might generate HTML." + (when (string-match "^http://[^/]+/?\\(.*\\)?$" str) + (let* ((path (match-string 1 str)) + (pos (position ?. path :from-end))) + (when (or (null pos) + (string-match "html?" (subseq path pos))) + str)))) + + +;;;###autoload +(defun erbutils-concat-symbols (&rest args) + "Like `concat' but applies to symbols, and returns an interned +concatted symbol. Also see fsbot's +`erbn-command-list-from-prefix'. + +Thanks to edrx on #emacs for suggesting 'symbol-name.." + (let* ((strings (mapcar 'symbol-name args)) + (str (apply 'concat strings))) + (intern str))) + + + + +(defun erbutils-remove-text--properties (str) + (let (str2) + (cond + ((stringp str) + (setq str2 (copy-sequence str)) + (set-text-properties 0 (length str2) nil str2) + str2) + (t (error "Not a string."))))) + + + + +(defun erbutils-remove-text-properties-maybe (str) + (if (stringp str) + (erbutils-remove-text-properties str) + str)) + + +(defun erbutils-buffer-string () + (buffer-substring-no-properties (point-min) (point-max))) + + +(defmacro erbutils-enabled-check (var) + `(when (or erbot-paranoid-p (not ,var)) + (error "Variable %s is disabled, or erbot-paranoid-p is t. " ',var))) + +;;; erbutils.el ends here diff --git a/elisp/erbot/erbwiki.el b/elisp/erbot/erbwiki.el new file mode 100644 index 0000000..4448a90 --- /dev/null +++ b/elisp/erbot/erbwiki.el @@ -0,0 +1,646 @@ +;;; erbwiki.el --- SECURITY RISK, READ BELOW. +;; Time-stamp: <2007-11-23 11:27:02 deego> +;; Copyright (C) 2002, 2003 D. Goel +;; Emacs Lisp Archive entry +;; Filename: erbwiki.el +;; Package: erbwiki +;; Author: D. Goel <deego@gnufans.org> +;; Keywords: +;; Version: +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot +;; Thanks: Alex Schroeder + +;; USING ERBWIKI.EL TO TRAIN YOUR BOTS ON WIKIS WITH LINES VERSION < +;; 0.3 IS A SECURITY RISK!! EARLIER LINES.EL CAN BE MADE TO EVAL AN +;; ARBITRARY LISP EXPRESSION, INCLUDING (SHELL-COMMAND "RM -RF"), WE +;; THINK, THOUGH WE HAVEN'T FIGURED OUT HOW. ANYHOW, USE LINES.EL > +;; 0.3 ONLY. + + +(defconst erbwiki-home-page + "http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot") + + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +;; See also: + +(defconst erbwiki-version "0.0dev") + + +;;========================================== +;;; Requires: +(eval-when-compile (require 'cl)) + +;;; Code: + +(defgroup erbwiki nil + "The group erbwiki." + :group 'applications) +(defcustom erbwiki-before-load-hooks nil + "Hooks to run before loading erbwiki." + :group 'erbwiki) +(defcustom erbwiki-after-load-hooks nil + "Hooks to run after loading erbwiki." + :group 'erbwiki) +(run-hooks 'erbwiki-before-load-hooks) + +;;; Real Code: + +;;<lion> It's like 2 lines of code to pull down the names of all the +;;pages. + +;; <lion> import xmlrpclib +;; <lion> srcwiki =xmlrpclib.ServerProxy("http://mywiki.org/?action=xmlrpc2") +;; <lion> allpages = srcwiki.getAllPages() +;; <lion> The wiki has to support the xml-rpc interface. +;; <lion> But for MoinMoin, +;;<lion> it's pretty much ubiquitous +;; http://twistedmatrix.com/wiki/moin/WikiRpc +;; <lion> Bayle Shanks has written a thing called the "InterWiki Gateway." +;; <lion> It's not quite mature yet, +;; <lion> but it's goal is to make it so that the XML-RPC API will work +;; with any wiki. +;; <lion> It'll just handle the back-end stuff of figuring out "what type +;; of wiki +;; is it" and "how do I scrape the information out." +;; <lion> But it's not quite there yet. + + +;;TODO: add this wiki: +;;http://www.nanoaging.com/wiki/index.php/Main_Page" +(defcustom erbwiki-index-pages + + '( + + + ("si" + "http://www.gnufans.net/cgi-bin/singularity.pl?" + "\"http://localhost/cgi-bin/singularity.pl?action=index\"" + nil + "singbot: " + ) + + ("ai2" + "http://www.ifi.unizh.ch/ailab/aiwiki/aiw.cgi?" + "\"http://www.ifi.unizh.ch/ailab/aiwiki/aiw.cgi?action=index\"" + nil + "singbot: " + ) + + + + ("sl" + "http://www.sl4.org/bin/wiki.pl?" + "\"http://www.sl4.org/bin/wiki.pl?action=index\"" + nil + "singbot: " + ) + + + + + ("fu" + "http://futures.wiki.taoriver.net/moin.cgi/" + "\"http://futures.wiki.taoriver.net/moin.cgi/TitleIndex?action=titleindex&mimetype=text/xml\"" + nil + "singbot: " + erbwiki-fetch-wiki-remove-tags + + ) + + + + ("ew" + "http://www.emacswiki.org/cgi-bin/wiki.pl?" + "\"http://www.emacswiki.org/cgi-bin/wiki.pl?action=index\"" + nil + "fsbot: " + ) + + + ("cw" + "http://www.emacswiki.org/cgi-bin/community/" + + "\"http://www.emacswiki.org/cgi-bin/community?action=index;raw=1\"" + nil + "fsbot: " + ) + + + + ("fw" + "http://www.etrumeus.com/ferment/" + "\"http://www.etrumeus.com/ferment/TitleIndex?action=titleindex\"" + nil + "wikibot: ") + + + ("fskdfhukdfhjkdfjk" + "http://www.gnufans.net/fsedu.pl?" + "\"http://www.gnufans.net/cgi-bin/fsedu.pl?action=index\"" + nil + "nobot: " + ) + + + ("ipfoobar" + + "http://imminst.org/pedia/PageIndex" + "\"http://new.imminst.org/pedia/\"" + nil + "singbot: " + ) + + + + + ("hwh" + "http://hurd.gnufans.org/bin/view/Hurd/" + "\"http://hurd.gnufans.org/bin/view/Hurd/WebTopicList?skin=plain\"" + erbwiki-get-fields-spaced + "hbot: " + ) + + + ("hwd" + "http://hurd.gnufans.org/bin/view/Distrib/" + "\"http://hurd.gnufans.org/bin/view/Distrib/WebTopicList?skin=plain\"" + erbwiki-get-fields-spaced + "hbot: " + ) + + + ("hwmain" + "http://hurd.gnufans.org/bin/view/Main/" + "\"http://hurd.gnufans.org/bin/view/Main/WebTopicList?skin=plain\"" + erbwiki-get-fields-spaced + "hbot: " + ) + + ("hwmach" + "http://hurd.gnufans.org/bin/view/Mach/" + "\"http://hurd.gnufans.org/bin/view/Mach/WebTopicList?skin=plain\"" + erbwiki-get-fields-spaced + "hbot: " + ) + + + ("hwmig" + "http://hurd.gnufans.org/bin/view/Mig/" + "\"http://hurd.gnufans.org/bin/view/Mig/WebTopicList?skin=plain\"" + erbwiki-get-fields-spaced + "hbot: " + ) + + + + ("hwg" + "http://hurd.gnufans.org/bin/view/GNU/" + "\"http://hurd.gnufans.org/bin/view/GNU/WebTopicList?skin=plain\"" + erbwiki-get-fields-spaced + "hbot: " + ) + + + ("hwt" + "http://hurd.gnufans.org/bin/view/TWiki/" + "\"http://hurd.gnufans.org/bin/view/TWiki/WebTopicList?skin=plain\"" + erbwiki-get-fields-spaced + "hbot: " + ) + + + + ;;("sm" + ;;"http://www.scarymath.org/math.pl?" + ;;"http://www.scarymath.org/math.pl?action=index" + ;;nil + ;;"ScBot: " + ;;) + + ("so" + "http://wiki.octave.org/wiki.pl?" + "\"http://wiki.octave.org/wiki.pl?action=index\"" + nil + "ScBot: " + ) + + ;;("sp" + ;; "http://www.scarymath.org/physics.pl?" + ;; "http://www.scarymath.org/physics.pl?action=index" + ;; nil + ;; "ScBot: " + ;;) + + + ;; towniebot + ("tbm" + "http://www.nevadamissouri.net/bin/view/Main/" + "\"http://www.nevadamissouri.net/bin/view/Main/WebTopicList?skin=plain\"" + nil + "towniebot: ") + + ;; now the big ones: + + + + ("twt" + "http://twiki.org/cgi-bin/view/TWiki/" + "\"http://twiki.org/cgi-bin/view/TWiki/WebTopicList?skin=plain\"" + nil + "TWikiBot: " + ) + + + ("twp" + "http://twiki.org/cgi-bin/view/Plugins/" + "\"http://twiki.org/cgi-bin/view/Plugins/WebTopicList?skin=plain\"" + nil + "TWikiBot: " + ) + + + ("twm" + "http://twiki.org/cgi-bin/view/Main/" + "\"http://twiki.org/cgi-bin/view/Main/WebTopicList?skin=plain\"" + nil + "TwikiBot: " + ) + + ("twc" + "http://twiki.org/cgi-bin/view/Codev/" + "\"http://twiki.org/cgi-bin/view/Codev/WebTopicList?skin=plain\"" + nil + "TWikiBot: " + ) + + ("twsupport" + "http://twiki.org/cgi-bin/view/Support/" + "\"http://twiki.org/cgi-bin/view/Support/WebTopicList?skin=plain\"" + nil + "TWikiBot: " + ) + + ("twsandbox" + "http://twiki.org/cgi-bin/view/Sandbox/" + "\"http://twiki.org/cgi-bin/view/Sandbox/WebTopicList?skin=plain\"" + nil + "TWikiBot: " + ) + + + ) + +"Page storing names of all pages. +As an example, consider this entry: + + (\"ew\" + \"http://www.emacswiki.org/cgi-bin/wiki.pl?\" + \"http://www.emacswiki.org/cgi-bin/wiki.pl?action=index\" + nil + \"fsbot: \" + nil + ) + +Most entries are obvious. ew refers to the nick name of the wiki used +when you run the function M-x erbwiki-do-it-all-one-wiki. + +Let's explain the 2 nils above. The first nil corresponds to the +default function erbwiki-get-fields. You replace it by another +function, example, erbwiki-get-fields-spaced if you want to use that +instead. +The second nil corresponds to the function used to dump the wiki, +which by default is erbwiki-fetch-wiki --- that function uses w3m. + + +" + + :group 'erbwiki) + +(defcustom erbwiki-this-wiki "NONE" + "Choose this as one of the cars of erbwiki-index-pages +and do your thing :) Should mostly be done for you by erbwiki-main +functions. " + :group 'erbwiki) + + +(defcustom erbwiki-file-name "~/pub/pub/fsbot-train/wiki-index" + "Please customize this. + +This filename, appropriately suffixed, stores the wiki's current or +last index. " + :group 'erbwiki) + + +(defcustom erbwiki-train-string + (concat + "%s%s is also at %s%s\n" + "%s%s is at %s%s\n" + ) + "Don't forget the \n at the end!" + :group 'erbwiki + ) + +(defcustom erbwiki-train-file-name "~/pub/pub/fsbot-train/wiki-train" + "Please customize this. + +With appropriate extension, this file stores the commands to be used to +train the bot. " + :group 'erbwiki) + +(defcustom erbwiki-fetch-wiki-function 'erbwiki-fetch-wiki + "This function should take a file as argument, and write into the file, +a single lisp object. The lisp object is a list of new pages in the +wiki. " + :group 'erbwiki) + + +(defcustom erbwiki-before-train-hooks nil + "Hooks to run before training.. + +Users might want to use these hooks to connect if they are not already +connected." + :group 'erbwiki) +;;;###autoload +(defun erbwiki-doit () + ;; not intetractive anymore. + (erbwiki-update) + (erbwiki-train)) + +;;;###autoload +(defun erbwiki-main-doit-all-one-wiki (wikiname &rest morewikies) + "CAUTION: nullifies idledo list. " + (interactive "sWhich Wiki? ") + (let* ((wikilists (cons wikiname morewikies)) + ctr) + (setq ctr wikilists) + (while ctr + (setq erbwiki-this-wiki (pop ctr)) + (erbwiki-update)) + (idledo-nullify) + (setq ctr wikilists) + (while ctr + (setq erbwiki-this-wiki (pop ctr)) + (erbwiki-train))) + (ignore-errors (idledo-start))) + +;;;###autoload +(defun erbwiki-main-main-ew () + (interactive) + (erbwiki-main-doit-all-one-wiki "ew")) + +;;;###autoload +(defun erbwiki-main-main-tbm () + (interactive) + (erbwiki-main-doit-all-one-wiki "tbm")) + +;;;###autoload +(defun erbwiki-main-main-tw () + (interactive) + (erbwiki-main-doit-all-one-wiki "twt" + ;;"twm" + "twc" + "twp" + "twsandbox" + "twsupport" + + )) + + +;;;###autoload +(defun erbwiki-main-main-mb () + (interactive) + (erbwiki-main-doit-all-one-wiki "mb")) + + +;;;###autoload +(defun erbwiki-main-main-hw () + (interactive) + (erbwiki-main-doit-all-one-wiki "hwh" "hwd" "hwmain" "hwmach" + "hwmig" "hwg" + "hwt" + )) + +;;;###autoload +(defun erbwiki-main-main-all-wikis () + (interactive) + (erbwiki-main-doit-all-one-wiki + "ew" "hwh" "hwd" "hwmain" "hwmach" "hwmig" "hwg" "hwt" "mb")) + + +;;;###autoload +(defun erbwiki-train () + (interactive) + (run-hooks 'erbwiki-before-train-hooks) + (erbtrain-file + (concat erbwiki-train-file-name + "-" erbwiki-this-wiki))) +;;;###autoload +(defun erbwiki-update () + ;;(interactive) + (require 'erball) + (save-window-excursion + (let + ((newfile (concat erbwiki-file-name + ".current-" + erbwiki-this-wiki + )) + (lastfile (concat erbwiki-file-name ".previous-" + erbwiki-this-wiki + )) + oldfields currentfields newfields + (train-name + (concat erbwiki-train-file-name "-" erbwiki-this-wiki)) + (wiki-string + (cadr (assoc erbwiki-this-wiki erbwiki-index-pages))) + (botname + (fifth (assoc erbwiki-this-wiki erbwiki-index-pages))) + (fetchfunction + (sixth (assoc erbwiki-this-wiki erbwiki-index-pages))) + ) + (unless botname (setq botname ", ")) + (when (file-exists-p lastfile) (mkback lastfile)) + (when (file-exists-p newfile) (copy-file newfile lastfile t)) + (funcall (or fetchfunction erbwiki-fetch-wiki-function) newfile) + (ignore-errors + (find-file lastfile) + (goto-char (point-min)) + (setq oldfields (ignore-errors (read (get-file-buffer lastfile))))) + (find-file newfile) + (goto-char (point-min)) + (setq currentfields (ignore-errors + (read (get-file-buffer newfile)))) + (setq newfields + (set-difference currentfields oldfields + :test 'equal + )) + (setq newfields (funcall erbwiki-filter-fields-function newfields)) + (kill-buffer (get-file-buffer newfile)) + (kill-buffer (get-file-buffer lastfile)) + (when (file-exists-p train-name) + (mkback train-name)) + (with-temp-file train-name + (while newfields + (insert (format erbwiki-train-string + botname + (car newfields) + wiki-string + (car + newfields) + botname + (car newfields) + wiki-string + (car newfields) + )) + (pop newfields))))) + (erbwiki-display) + ) + + +(defcustom erbwiki-filter-fields-function + 'erbwiki-filter-fields-default "") + +(defun erbwiki-filter-fields-default (fields) + ;; remove non-ascii characters + (delete-if + (lambda (arg) (string-match "[\200-\377]" (format "%s" arg))) + (copy-list fields))) + +;;;###autoload +(defun erbwiki-display () + (interactive) + (dired (file-name-directory erbwiki-train-file-name)) + (revert-buffer)) + + + +(defcustom erbwiki-dump-program "w3m -dump" + "Also try lynx -dump, curl. ") + +(defun erbwiki-fetch-wiki-lynx (filename) + (let ((erbwiki-dump-program "lynx -dump")) + (erbwiki-fetch-wiki filename))) + +(defcustom erbwiki-fetch-wiki-remove-tags-p nil "") + +(defun erbwiki-fetch-wiki-remove-tags (f) + (let ((erbwiki-fetch-wiki-remove-tags-p t)) + (erbwiki-fetch-wiki f))) + +(defun erbwiki-fetch-wiki (filename) + (require 'lines) + (let* + ((wiki-dump-name (expand-file-name "tmp-wiki-dump" + temporary-file-directory)) + (thisassoc + (assoc erbwiki-this-wiki + erbwiki-index-pages)) + (wiki-page + (cadr thisassoc)) + (index-page + (caddr thisassoc)) + (get-fields-fn (cadddr thisassoc)) + fields fieldslist) + (unless get-fields-fn + (setq get-fields-fn 'erbwiki-get-fields)) + (unless (stringp wiki-page) + (error "index page is not a stringp??")) + + (unless (stringp index-page) + (error "index page is not a stringp??")) + + ;;(setq index-page (concat wiki-page "action=index")) + ;; We will NOT add " " around the URL before calling ther + ;; shell-comnd, since the behavior of w3m -dump and lynx -dump + ;; differs in that case. Wehn the user wants a quote, she can + ;; supply it in the name of te url herself.. + + (shell-command (concat erbwiki-dump-program " " + index-page + ;;erbwiki-index-page + "" + " > " wiki-dump-name)) + (when erbwiki-fetch-wiki-remove-tags-p + (erbwiki-remove-tags-from-file wiki-dump-name)) + (setq fields (lines-get-fields-file wiki-dump-name)) + (kill-buffer (get-file-buffer wiki-dump-name)) + (setq fieldslist + (funcall get-fields-fn + fields)) + (with-temp-file filename + (insert (format "%S" fieldslist))))) + + + +(defun erbwiki-get-fields (fields) + "Given the fields as parsed by lines-get-fields, return a list of +the actual wiki fields." + (let (field) + (remove-if + (lambda (arg) (member arg (list '* + '[] + 'Search: + ))) + (erbutils-flatten + (remove-if + (lambda (field) + (or + (not (erbutils-listp-proper field)) + (not (< (length field) 3)) + (string-match "--" + (format "%s" + (first field))))) + fields))))) + + +(defun erbwiki-get-fields-spaced (fields) + "Given the fields as parsed by lines-get-fields, return a list of +the actual wiki fields." + (erbutils-flatten + (mapcar (lambda (field) + (if (equal (first field) '*) + (mapconcat + '(lambda (arg) (format "%s" arg)) + (cdr field) + "" + ))) + fields))) + + + +(defun erbwiki-remove-tags-from-file (file) + (interactive "fFile: ") + (find-file file) + (goto-char (point-min)) + (while + ;; accept any regexp greedily containing only tags with no + ;; spaces, or one starting with ?xml, in which case, allow + ;; spaces. but still be greedy. + (search-forward-regexp "<\\(?:\\?xml.*?\\|[^ \t\n]*?\\)>" nil t) + (replace-match "\n" nil t)) + (save-buffer)) + +(provide 'erbwiki) +(run-hooks 'erbwiki-after-load-hooks) + + + +;;; erbwiki.el ends here diff --git a/elisp/erbot/examples/CVS/Entries b/elisp/erbot/examples/CVS/Entries new file mode 100644 index 0000000..00ebe84 --- /dev/null +++ b/elisp/erbot/examples/CVS/Entries @@ -0,0 +1,2 @@ +/dotemacs-mybot/1.1/Sun Jul 22 23:26:03 2007// +D diff --git a/elisp/erbot/examples/CVS/Repository b/elisp/erbot/examples/CVS/Repository new file mode 100644 index 0000000..2dbfc3d --- /dev/null +++ b/elisp/erbot/examples/CVS/Repository @@ -0,0 +1 @@ +erbot/examples diff --git a/elisp/erbot/examples/CVS/Root b/elisp/erbot/examples/CVS/Root new file mode 100644 index 0000000..efd54f4 --- /dev/null +++ b/elisp/erbot/examples/CVS/Root @@ -0,0 +1 @@ +:pserver:anonymous@cvs.savannah.nongnu.org:/sources/erbot diff --git a/elisp/erbot/examples/CVS/Template b/elisp/erbot/examples/CVS/Template new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/elisp/erbot/examples/CVS/Template diff --git a/elisp/erbot/examples/dotemacs-mybot b/elisp/erbot/examples/dotemacs-mybot new file mode 100644 index 0000000..0b8633a --- /dev/null +++ b/elisp/erbot/examples/dotemacs-mybot @@ -0,0 +1,238 @@ +;; -*- emacs-lisp -*- + + +(setq erbot-nickserv-p t) + +(setq erc-prompt-for-nickserv-password nil) + +(setq erc-nickserv-passwords + '((freenode (("mybot" . "mypasswd"))))) + +(setq h4x0r-sometimes-replace + '(("ea" "33") ("er" "0r") ("a" "4") + ;;("b" "8") + ;;("d" "|>") + ("e" "3" "E") ;;("f" "|=") ("h" "|-|") + ;;("i" "1" "|") ;;("k" "|<" "x") + ;;("l" "1" "|_") ("m" "|\\/|") ("n" "|\\|") + ("o" "0") ;;("q" "@") + ("s" + "5" "Z" "$") + ;;("t" "+" "7") + ("ck" "x") ("u" "U") ;;("v" "\\/") + + ;("x" + ;X" "><") ("y" "j" + )) + +(add-to-list 'load-path "~/elisp") +(add-to-list 'load-path "~/elisp/erbot") +(add-to-list 'load-path "~/elisp/erbot/erbot") + +(setq erc-keywords '("mybot" "ownersname")) + +(setq fs-internal-english-weights + + '( + 30 ; doctor --- + 30 ; yow + 30 ; fortune + 2 ;; flame + )) + +(setq fs-internal-botito-mode nil) + +;; this optional step +;; helps the bot get the locations of the .el files in emacs +(let ((aa default-directory)) + (cd "/usr/share/emacs/site-lisp") + (normal-top-level-add-subdirs-to-load-path) + (cd aa)) + +(require 'cl) +;;(setq erc-port 6667) +(require 'erc) +(require 'erc-match) +(require 'erc-track) +(require 'erball) +(add-hook 'erc-mode-hook + '(lambda () (interactive) + (require 'erc-match) + (erc-match-mode 1) + ;;(erc-match-enable) + (require 'erc-button) + (erc-button-enable) + nil + )) + + +(setq bbdb-file "~/pub/data/botbbdb") + +(setq erbot-servers-channels-test + '(("irc.freenode.net" + ("#mychannel" + + "#mybot" + ) + 6667 ;; this is the port, optional, can be omitted. + ) + ("irc.gnome.org" + ( + "#mychannel2" + ) + ;; omitting the port here 6667 + ) + + )) + + + + + + +(erbot-install) + + + +(add-hook 'erc-server-376-hook + '(lambda (&rest args) + (interactive) + (erc-track-modified-channels-mode 1) + nil)) + +;;(global-unset-key "\C-cs") + +(global-set-key "\C-cj " 'erbot-join-servers) +(global-set-key [f9 f1] 'erbot-join-servers) + +(global-unset-key [f6]) +(global-set-key [f6 f6] 'erblog-show-targets) +(global-set-key [f6 f7] 'erblog-reset-targets) +(global-set-key "\C-c\C-c" 'erc-send-current-line) + + +;(global-set-key "\C-cr" 'erblog-reset-targets) + + + + + + + +;;(setq fs-limit-line-length 125) + + +;;(setq fs-limit-length + ;; 410) + +;;(setq fs-limit-lines 5 ) + +(setq bbdb-case-fold-search t) +(setq erc-auto-query t) + +;; Don't send more than 5 messages in 10 seconds. This prevents the +;; bot from getting kicked. +(setq erc-server-flood-penalty 2) +(setq erc-server-flood-margin 10) + +;; To restrict "automated" replies, change the "" below to your +;; favorite channels, example: +;;"\\(mychannel1\\|mychannel2\\)" +(setq fs-internal-query-target-regexp "") + +(setq fs-internal-google-level 60) + +(setq erbkarma-file "~/public_html/karma/karma") +(setq fs-internal-google-time 4) +(setq fs-internal-dictionary-time 4) + +(load "~/.emacs.private") + + +(setq erbkarma-tgt-check-string + "^\\(#mychannel\\)$") + +;; .emacs ends here.. + + + + + + +(setq erbot-nick "mybot") +(setq erc-user-full-name "My Bot") + +(setq erbot-servers-channels-main + '(("irc.freenode.net" + ("#mybot" + "#mychannel" + "#mychannel2" + )) + ("irc.gnome.org" + ( + "#mychannel" + + ) + + ))) + +(setq erbot-servers-channels erbot-servers-channels-main) + + +(setq fs-google-level 60) + + + +(setq erbot-servers-channels-test + '(("irc.freenode.net" + (;;"#fsbot" + "#mybot" + )) + ("irc.gnome.org" + (;;"#fsbotgnome" + ;;"#gnome" + ) + ) + + )) + +(setq bbdb-file-coding-system 'raw-text) +(require 'erball) +(erbunlisp-install) + +;; this delysid's server containing many dictionaries, if you prefer +;; the default server dict.org, just comment out this line. +(setq dictionary-server "dict.tu-graz.ac.at") + + +(fs-pf-load) +(fs-pv-load) + +(ignore-errors + (fs-user-init)) + +(require 'idledo) +(idledo-add-periodic-action-crude + '(fs-pv-save)) + +(add-hook 'kill-emacs-hook + 'fs-pv-save) + +;; consider uncommenting these +;;(add-to-list 'erblisp-allowed-words '&optional) +;;(add-to-list 'erblisp-allowed-words '&rest) + + +;;uncomment this only for a channel full of emacs hackers... see C-h v +;;(setq fs-internal-parse-error-p t) + +(setq units-dat-file "/usr/share/misc/units.dat") + +(add-to-list 'load-path "~/public_html/data") + + + + +;; .emacs ends here.. + + |