Import elisp libraries

[dotfiles/emacs.git] / lisp / dpaste.el

diff --git a/lisp/dpaste.el b/lisp/dpaste.el
new file mode 100644 (file)
index 0000000..66efe16
--- /dev/null
+++ b/lisp/dpaste.el
@@ -0,0 +1,100 @@
+;;; pastebin.el --- A simple interface to the www.pastebin.com webservice
+
+;;; Copyright (C) 2008 by Tapsell-Ferrier Limited
+
+;;; 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 2, or (at your option)
+;;; any later version.
+
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; see the file COPYING.  If not, write to the
+;;; Free Software Foundation, Inc.,   51 Franklin Street, Fifth Floor,
+;;; Boston, MA  02110-1301  USA
+
+;;; Commentary:
+;;;
+;;; Load this file and run:
+;;;
+;;;   M-x pastebin-buffer
+;;;
+;;; to send the whole buffer or select a region and run
+;;;
+;;;  M-x pastebin
+;;;
+;;; to send just the region.
+;;;
+;;; In either case the url that pastebin generates is left on the kill
+;;; ring and the paste buffer.
+
+
+;;; Code:
+
+(defvar dpastebin-type-assoc
+  '((emacs-lisp-mode . "887")
+    (scheme-mode . "887")
+    (python-mode . "795")
+    (nxml-mode . "840")))
+
+(defvar dpastebin-retrieved nil)
+
+(defvar dpastebin-expire-history '())
+
+(defun dpastebin-buffer (&optional expire)
+  "Send the whole buffer to paste.q0a.de."
+  (interactive (if current-prefix-arg
+                   (list (read-string "pastebin expire:" nil 'dpastebin-expire-history))))
+  (dpastebin (point-min) (point-max) expire))
+
+(defun dpastebin (start end &optional expire)
+  "An interface to the pastebin code snippet www service.
+
+See pastebin.com for more information about pastebin.
+
+Called interactively pastebin uses the current region for
+preference for sending... if the mark is NOT set then the entire
+buffer is sent.
+
+Argument START is the start of region.
+Argument END is the end of region.
+
+If PREFIX is used pastebin prompts for a prefix to be used as the
+virtual host to use.  For example use 'emacs' for 'emacs.pastebin.com'."
+  (interactive
+   (let ((pastebin-expire
+          (if current-prefix-arg
+              (read-string "pastebin expire:" nil 'dpastebin-expire-history))))
+     (if (mark)
+         (list (region-beginning) (region-end) pastebin-expire)
+       (list (point-min) (point-max) pastebin-expire))))
+  ;; Main function
+  (let* ((data (buffer-substring-no-properties start end))
+         (pastebin-url (format "http://paste.debian.net"))
+         (url-request-method "POST")
+         (url-request-extra-headers
+          '(("Content-Type" . "multipart/form-data")))
+         (url-request-data
+          (concat (format "paste=Send&lang=%s&expiry=%s&poster=%s&code=%s"
+                          (assoc-default major-mode dpastebin-type-assoc nil "878")
+                          (or expire "d")
+                          (user-full-name)
+                          (url-hexify-string data))))
+         (content-buf (url-retrieve pastebin-url
+                                    (lambda (arg)
+                                      (cond
+                                       ((equal :error (car arg))
+                                        (message (cdr arg)))
+                                       ((equal :redirect (car arg))
+                                        (setq pastebin-retrieved (cadr arg))
+                                        (with-temp-buffer
+                                          (insert pastebin-retrieved)
+                                          (clipboard-kill-ring-save (point-min) (point-max)))))))))
+    (car kill-ring)))
+
+(provide 'debian-pastebin)
+;;; pastebin.el ends here