Personal tools

Hpaste.el

From HaskellWiki

(Difference between revisions)
Jump to: navigation, search
(Add hpaste-get-paste. Fix a bug with url-mime-accept-string.)
(update version with language selection feature)
 
(7 intermediate revisions by 2 users not shown)
Line 1: Line 1:
hpaste.el is an Emacs Lisp library that integrates [http://hpaste.org hpaste] into Emacs. It provides two functions, <code>hpaste-paste-region</code> and <code>hpaste-paste-buffer</code>, which send the region or buffer to the hpaste server as required. Most things are customisable: do M-x customize and browse to the Hpaste group to see what you can change. Code is available under the GPL license. (see the [[Talk:Hpaste.el| talk page]] for a makefile allowing you to keep up-to-date on this programatically). Enjoy!
+
hpaste.el is an Emacs Lisp library that integrates [http://hpaste.org hpaste] into Emacs. It provides three functions: <code>hpaste-paste-region</code> and <code>hpaste-paste-buffer</code> send the region or buffer to the hpaste server as required, and <code>hpaste-get-paste</code> fetches a paste from the server and puts it in a new buffer. It allows annotation of existing pastes, controls the announcement on #haskell, and tries to be smart about keeping track of the last paste to ease annotation. Most things are customisable: do M-x customize and browse to the Hpaste group to see what you can change. Code is available under the GPL license. (see the [[Talk:Hpaste.el| talk page]] for a makefile allowing you to keep up-to-date on this programatically).
  +
  +
This file is also hosted in git [http://git.swclan.homelinux.org/hpaste.git here], where I've (andrewsw) been doing some work on it. Enjoy!
  +
  +
: ''' Update 18 Sep 10''': version 1.2 -- implement language selection feature
  +
: '''Update 16 Sep 10''': version 1.1 -- update to operate with new hpaste site. Changes to hpaste-get-paste, hpaste-paste-region and hpaste-after-paste.
   
 
: '''Update 13 Mar 08''': display URL of paste in minibuffer, and add it to kill ring. Add hpaste-get-paste.
 
: '''Update 13 Mar 08''': display URL of paste in minibuffer, and add it to kill ring. Add hpaste-get-paste.
Line 8: Line 8:
 
;;; hpaste.el -- Integration with hpaste: http://hpaste.org.
 
;;; hpaste.el -- Integration with hpaste: http://hpaste.org.
 
 
;; Author: David House <[email protected]>
+
;; Authors: David House <[email protected]>,
  +
;; Andrew Sackville-West <[email protected]>,
  +
;; and others.
  +
;;
  +
;; Change Log:
  +
;;
  +
;; 1.2 -- 18 Sep, 2010:
  +
;; implement language tagging
  +
;; 1.1 -- 16 Sep, 2010:
  +
;; fix hpaste-get-paste and hpaste-paste-region to handle new hpaste.org
  +
;;
 
;; Created: 14th April 2007
 
;; Created: 14th April 2007
 
;; Version: 1.0
 
;; Version: 1.0
 
;; License: GPL
 
;; License: GPL
  +
 
 
  +
;; Require
 
(require 'url)
 
(require 'url)
  +
  +
;; Definitions
 
 
 
(defgroup hpaste nil "Integration with the hpaste pastebin")
 
(defgroup hpaste nil "Integration with the hpaste pastebin")
  +
 
(defcustom hpaste-server "http://hpaste.org"
 
(defcustom hpaste-server "http://hpaste.org"
 
"Base URL for the hpaste server."
 
"Base URL for the hpaste server."
Line 28: Line 33:
 
:type '(boolean)
 
:type '(boolean)
 
:group 'hpaste)
 
:group 'hpaste)
  +
 
(defcustom hpaste-announce 'ask
 
(defcustom hpaste-announce 'ask
 
"Whether to announce the paste in the #haskell channel on
 
"Whether to announce the paste in the #haskell channel on
Line 36: Line 42:
 
(const :tag "Never announce" never))
 
(const :tag "Never announce" never))
 
:group 'hpaste)
 
:group 'hpaste)
  +
  +
(defcustom hpaste-lang 'ask
  +
"Whether to set the language tag in the paste. If ASK, then
  +
prompt every time. If ALWAYS, then the value of
  +
`hpaste-default-lang' will be silently and automatically
  +
used. If NEVER, then the paste will never be tagged with a
  +
language."
  +
:type '(choice (const :tag "Always tag the language" always)
  +
(const :tag "Ask whether to tag the language" ask)
  +
(const :tag "Never tag the language" never))
  +
:group 'hpaste)
  +
  +
  +
(defcustom hpaste-channel 0
  +
"The channel to use for making announcements. Specifying 0, No
  +
Channel, has the effect of having your post not announced ever,
  +
regardless of the setting of `hpaste-announce'. There is
  +
currently no prompting for which channel to announce to, so
  +
beware."
  +
:type '(choice (const :tag "No channel" 0)
  +
(const :tag "#haskell" 1)
  +
(const :tag "#xmonad" 2))
  +
:group 'hpaste)
  +
  +
(defconst hpaste-langs-alist '(("None" . 0)
  +
("Bash/shell" . 1)
  +
("C" . 2)
  +
("C++" . 3)
  +
("Common Lisp" . 4)
  +
("D" . 5)
  +
("Erlang" . 6)
  +
("Haskell" . 7)
  +
("Java" . 8)
  +
("JavaScript" . 9)
  +
("Literate Haskell" . 10)
  +
("Lua" . 11)
  +
("Objective-C" . 12)
  +
("OCaml" . 13)
  +
("Perl" . 14)
  +
("Perl" . 15) ;; sic
  +
("Prolog" . 16)
  +
("Python" . 17)
  +
("Ruby" . 18)
  +
("Scala" . 19)
  +
("XML" . 20))
  +
"The list of available language tags on hpaste.org. This list
  +
is subject to change without notice, possibly causing erroneous
  +
tagging. This should really be replaced with some function to
  +
actually parse the list of languages from the html...")
  +
  +
(defcustom hpaste-default-lang 0
  +
"The default language tag to use when pasting. If `hpaste-lang'
  +
is set to ALWAYS, then this value will be used silently. If
  +
`hpaste-lang' is set to ASK, the user selects yes, and this is
  +
set to None, 0, then the user will be prompted for a language
  +
to use. The user can always select 0, None, again to force no
  +
language tag."
  +
:type (cons 'choice (mapcar (lambda (x)
  +
(list 'const ':tag (car x)
  +
(cdr x)))
  +
hpaste-langs-alist))
  +
:group 'hpaste)
  +
  +
(defun hpaste-prompt-for-lang ()
  +
(or (cdr (assoc
  +
(completing-read (format "Enter the language [%s]:" hpaste-default-lang)
  +
hpaste-langs-alist) hpaste-langs-alist))
  +
hpaste-default-lang))
  +
  +
;; this is sort of an absurdley complex set of conditions... but it works
  +
(defun hpaste-paste-lang ()
  +
"Function to determine the language to use for the current
  +
paste, if any. Makes use of `hpaste-default-lang' and
  +
`hpaste-lang' to figure out what to do. See the docstrings for
  +
those variable to get an understanding."
  +
(cond ((eq hpaste-lang 'always) hpaste-default-lang)
  +
((eq hpaste-lang 'ask) (if (y-or-n-p "Show language?")
  +
(if (eq hpaste-default-lang 0)
  +
(hpaste-prompt-for-lang)
  +
hpaste-default-lang)
  +
0))
  +
(t 0))) ;; the 'never case...
  +
 
 
 
(defvar hpaste-last-paste-id nil
 
(defvar hpaste-last-paste-id nil
Line 44: Line 133:
 
and tell them that everything went smoothly, and save the paste
 
and tell them that everything went smoothly, and save the paste
 
ID for use as a default ID for annotations."
 
ID for use as a default ID for annotations."
(message "Paste successful: " (cadr redirect))
+
(if redirect
(kill-new (format (cadr redirect))
+
(progn
(if (eq (car redirect) ':redirect)
+
(message "Paste successful: %s" (cadr redirect))
(progn
+
(kill-new (format (cadr redirect)))
(setq url (cadr redirect))
+
(if (eq (car redirect) ':redirect)
(string-match "/\\([0-9]*\\)\\(#.*\\)?$" url)
+
(progn
(let ((id (match-string 1 url)))
+
(setq url (cadr redirect))
(if id (setq hpaste-last-paste-id id))))))
+
;; (string-match "/\\([0-9]*\\)\\(#.*\\)?$" url) ;; original regex
  +
(string-match ".*/\\([0-9]*\\)/.*$" url) ;; a hack of a regex
  +
(let ((id (match-string 1 url)))
  +
(if id (setq hpaste-last-paste-id id))))))
  +
(message "%s" "No result from server.")))
 
 
 
(defun hpaste-prompt-for-annotate ()
 
(defun hpaste-prompt-for-annotate ()
Line 66: Line 155:
 
(input (read-from-minibuffer prompt)))
 
(input (read-from-minibuffer prompt)))
 
(if (> (length input) 0) input hpaste-last-paste-id))))
 
(if (> (length input) 0) input hpaste-last-paste-id))))
  +
 
 
(defun hpaste-paste-region (beg end)
+
(defun hpaste-paste-region (beg end)
 
"Send the region to the hpaste server specified in
 
"Send the region to the hpaste server specified in
 
`hpaste-server'. Use the nick in `hpaste-default-nick', or prompt
 
`hpaste-server'. Use the nick in `hpaste-default-nick', or prompt
Line 73: Line 163:
 
just not filling out a nick when prompted (just hit RET). Prompt
 
just not filling out a nick when prompted (just hit RET). Prompt
 
for a title, unless `hpaste-blank-title' is non-NIL, in which
 
for a title, unless `hpaste-blank-title' is non-NIL, in which
case just send a blank title. Pastes will be announced in
+
case just send a blank title. Pastes will be announced on
#haskell on Freenode according to `hpaste-announce', see the
+
Freenode in the channel as specified in `hpaste-channel', per the
docstring of that variable for more information.
+
value of `hpaste-announce'. See the docstring of those variables
  +
for more information.
  +
  +
This function does not currently implement the selection of
  +
source code language as is available on hpaste.
 
 
 
For more information on hpaste, see http://hpaste.org"
 
For more information on hpaste, see http://hpaste.org"
Line 81: Line 171:
 
(let* ((nick (or hpaste-default-nick (read-from-minibuffer "Nick: ")))
 
(let* ((nick (or hpaste-default-nick (read-from-minibuffer "Nick: ")))
 
(title (if hpaste-blank-title "" (read-from-minibuffer "Title: ")))
 
(title (if hpaste-blank-title "" (read-from-minibuffer "Title: ")))
  +
(language (hpaste-paste-lang))
 
(annot-id (hpaste-prompt-for-annotate))
 
(annot-id (hpaste-prompt-for-annotate))
(announce (if (or (eq hpaste-announce 'always)
+
(announce (or (eq hpaste-announce 'always)
(and (eq hpaste-announce 'ask)
+
(and (eq hpaste-announce 'ask)
(y-or-n-p "Announce paste? ")))
+
(y-or-n-p "Announce paste? "))))
"&announce=true"
+
""))
+
(url (concat hpaste-server "/control"))
 
(url (concat hpaste-server
 
(if annot-id (concat "/annotate/" annot-id)
 
"/new")))
 
 
(url-request-method "POST")
 
(url-request-method "POST")
 
(url-request-extra-headers
 
(url-request-extra-headers
 
'(("Content-Type" . "application/x-www-form-urlencoded")))
 
'(("Content-Type" . "application/x-www-form-urlencoded")))
 
(url-mime-accept-string "*/*")
 
(url-mime-accept-string "*/*")
(url-request-data
+
(url-request-data (concat
(format "content=%s&nick=%s&title=%s%s&x=0&y=0\r\n"
+
(if annot-id
(url-hexify-string (buffer-substring-no-properties beg end))
+
(format "annotation_of=%s&" annot-id)
(url-hexify-string nick)
+
"")
(url-hexify-string title)
+
(format "fval[1]=%s&fval[2]=%s&fval[3]=%d&fval[4]=%d&fval[5]=%s&email=&submit=true\r\n"
announce)))
+
(url-hexify-string title)
  +
(url-hexify-string nick)
  +
language
  +
(if announce hpaste-channel 0)
  +
(url-hexify-string (buffer-substring-no-properties beg end))))))
  +
 
(url-retrieve url 'hpaste-after-paste)))
 
(url-retrieve url 'hpaste-after-paste)))
   
(defun hpaste-get-paste (id &optional annotation)
+
;; new hpaste.org form fields
  +
;;
  +
;; fval[1] = Title:, String
  +
;; fval[2] = Author:, String
  +
;; fval[3] = Language, see hpaste-lang-alist
  +
;; fval[4] = Channel: Int 0=no channel, 1=#haskell 2=#xmonad
  +
;; fval[5] = Paste; String
  +
;;
  +
  +
  +
  +
(defun hpaste-get-paste (id)
 
"Fetch the contents of the paste from hpaste into a new buffer."
 
"Fetch the contents of the paste from hpaste into a new buffer."
 
(interactive "nPaste #: ")
 
(interactive "nPaste #: ")
   
(setq annotation (or annotation (read-from-minibuffer "Annotation: ")))
 
 
(let ((url-request-method "GET")
 
(let ((url-request-method "GET")
 
(url-request-extra-headers nil)
 
(url-request-extra-headers nil)
 
(url-mime-accept-string "*/*")
 
(url-mime-accept-string "*/*")
 
(url (url-generic-parse-url
 
(url (url-generic-parse-url
(format "http://hpaste.org/%s/%s/plain" id annotation))))
+
(format "http://hpaste.org/raw/%s" id))))
 
(setq hpaste-buffer (url-retrieve-synchronously url))
 
(setq hpaste-buffer (url-retrieve-synchronously url))
  +
(setq hpaste-last-paste-id id)
   
 
(with-current-buffer hpaste-buffer
 
(with-current-buffer hpaste-buffer
 
(progn
 
(progn
 
(set-visited-file-name (format "hpaste #%s" id))
 
(set-visited-file-name (format "hpaste #%s" id))
  +
(goto-char (point-min))
 
(search-forward-regexp "\n\n")
 
(search-forward-regexp "\n\n")
 
(delete-region (point-min) (point))
 
(delete-region (point-min) (point))

Latest revision as of 04:06, 19 September 2010

hpaste.el is an Emacs Lisp library that integrates hpaste into Emacs. It provides three functions: hpaste-paste-region and hpaste-paste-buffer send the region or buffer to the hpaste server as required, and hpaste-get-paste fetches a paste from the server and puts it in a new buffer. It allows annotation of existing pastes, controls the announcement on #haskell, and tries to be smart about keeping track of the last paste to ease annotation. Most things are customisable: do M-x customize and browse to the Hpaste group to see what you can change. Code is available under the GPL license. (see the talk page for a makefile allowing you to keep up-to-date on this programatically).

This file is also hosted in git here, where I've (andrewsw) been doing some work on it. Enjoy!

Update 18 Sep 10: version 1.2 -- implement language selection feature
Update 16 Sep 10: version 1.1 -- update to operate with new hpaste site. Changes to hpaste-get-paste, hpaste-paste-region and hpaste-after-paste.
Update 13 Mar 08: display URL of paste in minibuffer, and add it to kill ring. Add hpaste-get-paste.
Update 13 Dec 07: fixed problems with "Wrong type argument: stringp, nil" appearing after pasting.
;;; hpaste.el -- Integration with hpaste: http://hpaste.org.
 
;; Authors: David House <[email protected]>, 
;;          Andrew Sackville-West <[email protected]>,
;;          and others.
;;
;; Change Log:
;; 
;; 1.2 -- 18 Sep, 2010:
;;   implement language tagging
;; 1.1 -- 16 Sep, 2010:
;;   fix hpaste-get-paste and hpaste-paste-region to handle new hpaste.org
;; 
;; Created: 14th April 2007
;; Version: 1.0
;; License: GPL

 
;; Require
(require 'url)

;; Definitions
 
(defgroup hpaste nil "Integration with the hpaste pastebin")

(defcustom hpaste-server "http://hpaste.org" 
  "Base URL for the hpaste server."
  :type '(string)
  :group 'hpaste)
(defcustom hpaste-default-nick nil
  "What to tell the server your nick is. If NIL, then prompt every time."
  :type '(choice (string) (const :tag "Ask every time" nil))
  :group 'hpaste)
(defcustom hpaste-blank-title nil
  "If non-NIL, don't send a title to the server."
  :type '(boolean)
  :group 'hpaste)

(defcustom hpaste-announce 'ask
  "Whether to announce the paste in the #haskell channel on
Freenode. If ALWAYS, then announce every time. If ASK, then
prompt every time. If NEVER, then never announce."
  :type '(choice (const :tag "Always announce" always)
                 (const :tag "Ask each time" ask) 
                 (const :tag "Never announce" never))
  :group 'hpaste)

(defcustom hpaste-lang 'ask
  "Whether to set the language tag in the paste. If ASK, then
  prompt every time. If ALWAYS, then the value of
  `hpaste-default-lang' will be silently and automatically
  used. If NEVER, then the paste will never be tagged with a
  language."
  :type '(choice (const :tag "Always tag the language" always)
		 (const :tag "Ask whether to tag the language" ask)
		 (const :tag "Never tag the language" never))
  :group 'hpaste)


(defcustom hpaste-channel 0
  "The channel to use for making announcements. Specifying 0, No
Channel, has the effect of having your post not announced ever,
regardless of the setting of `hpaste-announce'. There is
currently no prompting for which channel to announce to, so
beware."
  :type '(choice (const :tag "No channel" 0)
		 (const :tag "#haskell" 1)
		 (const :tag "#xmonad" 2))
  :group 'hpaste)

(defconst hpaste-langs-alist '(("None" . 0)
			       ("Bash/shell" . 1)
			       ("C" . 2)
			       ("C++" . 3)
			       ("Common Lisp" . 4)
			       ("D" . 5)
			       ("Erlang" . 6)
			       ("Haskell" . 7)
			       ("Java" . 8)
			       ("JavaScript" . 9)
			       ("Literate Haskell" . 10)
			       ("Lua" . 11)
			       ("Objective-C" . 12)
			       ("OCaml" . 13)
			       ("Perl" . 14)
			       ("Perl" . 15) ;; sic
			       ("Prolog" . 16)
			       ("Python" . 17)
			       ("Ruby" . 18)
			       ("Scala" . 19)
			       ("XML" . 20))
  "The list of available language tags on hpaste.org. This list
  is subject to change without notice, possibly causing erroneous
  tagging. This should really be replaced with some function to
  actually parse the list of languages from the html...")

(defcustom hpaste-default-lang 0
  "The default language tag to use when pasting. If `hpaste-lang'
  is set to ALWAYS, then this value will be used silently. If
  `hpaste-lang' is set to ASK, the user selects yes, and this is
  set to None, 0, then the user will be prompted for a language
  to use. The user can always select 0, None, again to force no
  language tag."
  :type (cons 'choice (mapcar (lambda (x)
				(list 'const ':tag (car x)
				      (cdr x)))
			      hpaste-langs-alist))
  :group 'hpaste)

(defun hpaste-prompt-for-lang ()
   (or (cdr (assoc
	     (completing-read (format "Enter the language [%s]:" hpaste-default-lang) 
			      hpaste-langs-alist) hpaste-langs-alist))
       hpaste-default-lang)) 

;; this is sort of an absurdley complex set of conditions... but it works
(defun hpaste-paste-lang ()
  "Function to determine the language to use for the current
paste, if any. Makes use of `hpaste-default-lang' and
`hpaste-lang' to figure out what to do. See the docstrings for
those variable to get an understanding."
  (cond ((eq hpaste-lang 'always) hpaste-default-lang)
	((eq hpaste-lang 'ask) (if (y-or-n-p "Show language?")
				   (if (eq hpaste-default-lang 0)
				       (hpaste-prompt-for-lang)
				     hpaste-default-lang)
				 0))
	(t 0))) ;; the 'never case...

 
(defvar hpaste-last-paste-id nil
  "Numerical ID of the last paste.")
 
(defun hpaste-after-paste (&optional redirect)
  "Callback that runs after a paste is made. Messages the user
and tell them that everything went smoothly, and save the paste
ID for use as a default ID for annotations."
  (if redirect
      (progn
	(message "Paste successful: %s" (cadr redirect))
	(kill-new (format (cadr redirect)))
	(if (eq (car redirect) ':redirect)
	    (progn 
	      (setq url (cadr redirect))
;;	      (string-match "/\\([0-9]*\\)\\(#.*\\)?$" url) ;; original regex
	      (string-match ".*/\\([0-9]*\\)/.*$" url) ;; a hack of a regex 
	      (let ((id (match-string 1 url)))
		(if id (setq hpaste-last-paste-id id))))))
    (message "%s" "No result from server.")))
 
(defun hpaste-prompt-for-annotate ()
  "Ask the user whether they want to send the paste as an
annotation, and if so, the ID of the paste to
annotate (defaulting to the last paste made through this
interface)."
  (if (y-or-n-p "Send as annotation? ")
      (let* ((prompt
              (if hpaste-last-paste-id
                  (format "Paste to annotate (default %s): "
                          hpaste-last-paste-id)
                "Paste to annotate: "))
             (input (read-from-minibuffer prompt)))
        (if (> (length input) 0) input hpaste-last-paste-id))))

 
(defun hpaste-paste-region (beg end) 
  "Send the region to the hpaste server specified in
`hpaste-server'. Use the nick in `hpaste-default-nick', or prompt
for one if that is NIL. You can still appear as (anonymous) by
just not filling out a nick when prompted (just hit RET). Prompt
for a title, unless `hpaste-blank-title' is non-NIL, in which
case just send a blank title. Pastes will be announced on
Freenode in the channel as specified in `hpaste-channel', per the
value of `hpaste-announce'. See the docstring of those variables
for more information.

This function does not currently implement the selection of
source code language as is available on hpaste.
 
For more information on hpaste, see http://hpaste.org"
  (interactive "r")
  (let* ((nick (or hpaste-default-nick (read-from-minibuffer "Nick: ")))
         (title (if hpaste-blank-title "" (read-from-minibuffer "Title: ")))
	 (language (hpaste-paste-lang))
         (annot-id (hpaste-prompt-for-annotate))
         (announce (or (eq hpaste-announce 'always)
		       (and (eq hpaste-announce 'ask)
			    (y-or-n-p "Announce paste? "))))

         (url (concat hpaste-server "/control"))
         (url-request-method "POST")
         (url-request-extra-headers
          '(("Content-Type" . "application/x-www-form-urlencoded")))
         (url-mime-accept-string "*/*")
         (url-request-data (concat 
			    (if annot-id
				(format "annotation_of=%s&" annot-id)
			      "") 
			    (format "fval[1]=%s&fval[2]=%s&fval[3]=%d&fval[4]=%d&fval[5]=%s&email=&submit=true\r\n" 
				    (url-hexify-string title)
				    (url-hexify-string nick)
				    language
				    (if announce hpaste-channel 0)
				    (url-hexify-string (buffer-substring-no-properties beg end))))))

    (url-retrieve url 'hpaste-after-paste)))

;; new hpaste.org form fields
;;
;; fval[1] = Title:, String
;; fval[2] = Author:, String
;; fval[3] = Language, see hpaste-lang-alist
;; fval[4] = Channel: Int 0=no channel, 1=#haskell 2=#xmonad
;; fval[5] = Paste; String
;;



(defun hpaste-get-paste (id)
  "Fetch the contents of the paste from hpaste into a new buffer."
  (interactive "nPaste #: ")

  (let ((url-request-method "GET")
        (url-request-extra-headers nil)
        (url-mime-accept-string "*/*")
        (url (url-generic-parse-url
	      (format "http://hpaste.org/raw/%s" id))))
    (setq hpaste-buffer (url-retrieve-synchronously url))
   (setq hpaste-last-paste-id id)

     (with-current-buffer hpaste-buffer
       (progn
         (set-visited-file-name (format "hpaste #%s" id))
	 (goto-char (point-min))
         (search-forward-regexp "\n\n")
         (delete-region (point-min) (point))
         (set-buffer-modified-p nil)
         (switch-to-buffer hpaste-buffer)
         (if haskell-version
             (haskell-mode)
           (normal-mode))))))

(defun hpaste-paste-buffer ()
  "Like `hpaste-paste-region', but paste the entire buffer instead."
  (interactive)
  (hpaste-paste-region (point-min) (point-max)))
 
(provide 'hpaste)