diff options
Diffstat (limited to 'elisp/erbot/contrib')
23 files changed, 7500 insertions, 0 deletions
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 |