Skip to content
Newer
Older
100644 273 lines (240 sloc) 10 KB
1b6dc56 @ruediger initial release
authored Nov 30, 2009
1 ;; codepad.el --- Emacs integration for codepad.org
2 ;;
3 ;; Author: Rüdiger Sonderfeld <ruediger@c-plusplus.de>
afeb25c @ruediger added Thomas to the Contributor list
authored Nov 30, 2009
4 ;; Contributors: Thomas Weidner <thomas001le@gmail.com>
bfe6a10 @ruediger added url to github
authored Nov 30, 2009
5 ;; Website: http://github.com/ruediger/emacs-codepad
78c64c2 @ruediger comply with Convention for Library Headers (see (elisp) Library Headers)
authored Nov 30, 2009
6 ;; Created: <2009-11-29>
1b6dc56 @ruediger initial release
authored Nov 30, 2009
7 ;; Keywords: codepad paste pastie pastebin
8 ;;
9 ;; This code is inspired by gist.el (written by Christian Neukirchen et.al.)
10 ;; see http://github.com/defunkt/gist.el/blob/master/gist.el
11 ;;
12 ;; This file is NOT part of GNU Emacs.
13 ;;
14 ;; This is free software; you can redistribute it and/or modify it under
15 ;; the terms of the GNU General Public License as published by the Free
16 ;; Software Foundation; either version 2, or (at your option) any later
17 ;; version.
18 ;;
19 ;; This is distributed in the hope that it will be useful, but WITHOUT
20 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
21 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
22 ;; for more details.
23 ;;
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs; see the file COPYING. If not, write to the
26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
27 ;; MA 02111-1307, USA.
28
29 ;;; Commentary:
30
31 ;; This code can be used to paste code to codepad.org.
32
3ddcaac @ruediger fixed checkdoc errors.
authored Nov 30, 2009
33 ;; codepad-paste-region pastes a region to codepad.org. The URL is printed
0ed925e @ruediger paste async
authored Nov 30, 2009
34 ;; and if codepad-view is T opened in the browser.
1b6dc56 @ruediger initial release
authored Nov 30, 2009
35 ;;
36 ;; codepad-paste-buffer pastes the whole buffer.
37
78c64c2 @ruediger comply with Convention for Library Headers (see (elisp) Library Headers)
authored Nov 30, 2009
38 ;; TODO:
1b6dc56 @ruediger initial release
authored Nov 30, 2009
39
9719105 @ruediger added README
authored Nov 30, 2009
40 ;; * fetch Output from codepad.org (if run is True)
1b6dc56 @ruediger initial release
authored Nov 30, 2009
41 ;; * support projects (http://project.codepad.org)
42 ;; * support user accounts
43
78c64c2 @ruediger comply with Convention for Library Headers (see (elisp) Library Headers)
authored Nov 30, 2009
44 ;; Idea:
1b6dc56 @ruediger initial release
authored Nov 30, 2009
45
99636ce @ruediger private flag now behaves similar to sync flag
authored Nov 30, 2009
46 ;; add a local variable to each buffer with (a list?) of codepad ids so you
47 ;; new pastes from this buffer are added as a reply to the original paste.
1b6dc56 @ruediger initial release
authored Nov 30, 2009
48
49 ;;; Code:
50
ce40faa @ruediger added docstrings
authored Nov 30, 2009
51 (defconst +codepad-url+ "http://codepad.org"
3ddcaac @ruediger fixed checkdoc errors.
authored Nov 30, 2009
52 "Url to codepad.org.")
1b6dc56 @ruediger initial release
authored Nov 30, 2009
53
54 (defconst +codepad-lang+ '((c-mode . "C")
55 (c++-mode . "C++")
56 (d-mode . "D")
57 (haskell-mode . "Haskell")
58 (lua-mode . "Lua")
59 (ocaml-mode . "OCaml")
60 (php-mode . "PHP")
61 (perl-mode . "Perl")
62 (python-mode . "Python")
63 (ruby-mode . "Ruby")
64 (scheme-mode . "Scheme")
ce40faa @ruediger added docstrings
authored Nov 30, 2009
65 (tcl-mode . "Tcl"))
3ddcaac @ruediger fixed checkdoc errors.
authored Nov 30, 2009
66 "Association of major-modes to language names used by codepad.org.")
1b6dc56 @ruediger initial release
authored Nov 30, 2009
67
ce40faa @ruediger added docstrings
authored Nov 30, 2009
68 (defconst +codepad-default-lang+ "Plain Text"
9351c11 @ruediger fixed typo
authored Nov 30, 2009
69 "Language if `major-mode' is not supported by codepad.org.")
1b6dc56 @ruediger initial release
authored Nov 30, 2009
70
71 (defgroup codepad nil
72 "Codepad paste support"
73 :prefix "codepad-"
74 :tag "Codepad"
75 :group 'external
bfe6a10 @ruediger added url to github
authored Nov 30, 2009
76 :link '(url-link "http://github.com/ruediger/emacs-codepad"))
1b6dc56 @ruediger initial release
authored Nov 30, 2009
77
78 (defcustom codepad-private 'ask
79 "Private pastes?"
80 :group 'codepad
45b2321 @ruediger improved custom menu
authored Nov 30, 2009
81 :type '(radio
82 (const :tag "Always ask" :value ask)
83 (const :tag "Check prefix" :value prefix)
84 (const :tag "No" :value no)
85 (const :tag "Yes" :value yes)))
1b6dc56 @ruediger initial release
authored Nov 30, 2009
86
87 (defcustom codepad-run 'yes
88 "Run pastes?"
89 :group 'codepad
45b2321 @ruediger improved custom menu
authored Nov 30, 2009
90 :type '(radio
91 (const :tag "Always ask" :value ask)
92 (const :tag "Check prefix" :value prefix)
93 (const :tag "No" :value no)
94 (const :tag "Yes" :value yes)))
1b6dc56 @ruediger initial release
authored Nov 30, 2009
95
96 (defcustom codepad-view t
97 "View paste in browser?"
98 :group 'codepad
99 :type 'boolean)
100
a051b66 @ruediger cleaned up fetch-code (don't parse headers with regex use local vars)
authored Nov 30, 2009
101 (defcustom codepad-autoset-mode t
102 "Try to determine and set mode for fetched code?"
103 :group 'codepad
104 :type 'boolean)
105
166614f @ruediger added more fixes from thomas001.
authored Nov 30, 2009
106 (defcustom codepad-use-x-clipboard t
107 "Copy URL also to the X clipboard?"
108 :group 'codepad
109 :type 'boolean)
110
1b6dc56 @ruediger initial release
authored Nov 30, 2009
111 (defun codepad-read-p (prompt &optional default)
3ddcaac @ruediger fixed checkdoc errors.
authored Nov 30, 2009
112 "Read true (t,y,true,yes) or false (nil,false,no) from the minibuffer.
113 Uses PROMPT as prompt and DEFAULT is the default value."
99636ce @ruediger private flag now behaves similar to sync flag
authored Nov 30, 2009
114 (let ((val (downcase (read-string (concat prompt " [default '"
115 (if default "Yes" "No") "']: ")))))
1b6dc56 @ruediger initial release
authored Nov 30, 2009
116 (cond
117 ((string= val "") default)
118 ((member val '("t" "y" "true" "yes")) t)
119 ((member val '("nil" "f" "n" "false" "no")) nil)
99636ce @ruediger private flag now behaves similar to sync flag
authored Nov 30, 2009
120 (t (message (concat "Wrong input '" val
121 "'! Please enter either Yes or No"))
1b6dc56 @ruediger initial release
authored Nov 30, 2009
122 (codepad-read-p prompt default)))))
123
124 (defun codepad-interactive-option (var prompt)
3ddcaac @ruediger fixed checkdoc errors.
authored Nov 30, 2009
125 "Handle interactive option for VAR. Use PROMPT if user is asked."
1b6dc56 @ruediger initial release
authored Nov 30, 2009
126 (case var
127 ((ask) (codepad-read-p prompt))
128 ((no) nil)
129 ((yes) t)
130 ((prefix) current-prefix-arg)
131 (t var)))
132
133 (defun codepad-true-or-false (val)
3ddcaac @ruediger fixed checkdoc errors.
authored Nov 30, 2009
134 "Convert VAL into a string True or False."
1b6dc56 @ruediger initial release
authored Nov 30, 2009
135 (if val
136 "True"
137 "False"))
138
3ddcaac @ruediger fixed checkdoc errors.
authored Nov 30, 2009
139 (defun codepad-url-encode (string)
140 "Encode STRING. Like `url-hexify-string' but space is turned into +."
1b6dc56 @ruediger initial release
authored Nov 30, 2009
141 (replace-regexp-in-string "%20" "+" (url-hexify-string string)))
142
143 ;; copied from gist.el
144 (defun codepad-make-query-string (params)
3ddcaac @ruediger fixed checkdoc errors.
authored Nov 30, 2009
145 "Return a query string constructed from PARAMS.
146 PARAMS should be a list with elements of the form (KEY . VALUE). KEY and VALUE
1b6dc56 @ruediger initial release
authored Nov 30, 2009
147 should both be strings."
148 (mapconcat
149 (lambda (param)
4ee62f9 @ruediger fixed: rename codepad-hexify-string to codepad-url-encode
authored Nov 30, 2009
150 (concat (codepad-url-encode (car param)) "="
151 (codepad-url-encode (cdr param))))
1b6dc56 @ruediger initial release
authored Nov 30, 2009
152 params "&"))
153
154 ;;;###autoload
3ddcaac @ruediger fixed checkdoc errors.
authored Nov 30, 2009
155 (defun* codepad-paste-region (begin end
166614f @ruediger added more fixes from thomas001.
authored Nov 30, 2009
156 &optional (private 'check-custom)
157 callback cbargs)
158 "Paste region to codepad.org.
159 Call CALLBACK as (apply CALLBACK
160 URL ERR-P CBARGS) where ERR-P is nil and URL is the resulted url
161 in the case of success or ERR is an error descriptor."
1b6dc56 @ruediger initial release
authored Nov 30, 2009
162 (interactive "r")
99636ce @ruediger private flag now behaves similar to sync flag
authored Nov 30, 2009
163 (let* ((private (codepad-interactive-option (if (eql private 'check-custom)
164 codepad-private
165 private)
166 "Private Paste?"))
1b6dc56 @ruediger initial release
authored Nov 30, 2009
167 (lang (or (cdr (assoc major-mode +codepad-lang+))
168 +codepad-default-lang+))
169 (run (codepad-interactive-option codepad-run "Run Paste?"))
170 (url-max-redirections 0)
171 (url-request-method "POST")
99636ce @ruediger private flag now behaves similar to sync flag
authored Nov 30, 2009
172 (url-request-extra-headers
173 '(("Content-type" . "application/x-www-form-urlencoded")))
1b6dc56 @ruediger initial release
authored Nov 30, 2009
174 (url-request-data
3ddcaac @ruediger fixed checkdoc errors.
authored Nov 30, 2009
175 (codepad-make-query-string
1b6dc56 @ruediger initial release
authored Nov 30, 2009
176 `(("submit" . "Submit")
177 ("private" . ,(codepad-true-or-false private))
178 ("run" . ,(codepad-true-or-false run))
179 ("lang" . ,lang)
0ed925e @ruediger paste async
authored Nov 30, 2009
180 ("code" . ,(buffer-substring begin end))))))
a9c03fb @ruediger removed sync pasting and cleaned up hack (no re-search-forward!)
authored Nov 30, 2009
181 (url-retrieve +codepad-url+
166614f @ruediger added more fixes from thomas001.
authored Nov 30, 2009
182 (lambda (status callback cbargs)
a9c03fb @ruediger removed sync pasting and cleaned up hack (no re-search-forward!)
authored Nov 30, 2009
183 (let ((url (plist-get status :redirect))
184 (err (plist-get status :error)))
166614f @ruediger added more fixes from thomas001.
authored Nov 30, 2009
185 (when callback
186 (apply callback url err cbargs))
a9c03fb @ruediger removed sync pasting and cleaned up hack (no re-search-forward!)
authored Nov 30, 2009
187 (when err
188 (signal (car err) (cdr err)))
189 (message "Paste created: %s" url)
190 (when codepad-view (browse-url url))
166614f @ruediger added more fixes from thomas001.
authored Nov 30, 2009
191 (let ((x-select-enable-clipboard
192 (or codepad-use-x-clipboard
193 x-select-enable-clipboard)))
194 (kill-new url))
a9c03fb @ruediger removed sync pasting and cleaned up hack (no re-search-forward!)
authored Nov 30, 2009
195 (kill-buffer (current-buffer))
166614f @ruediger added more fixes from thomas001.
authored Nov 30, 2009
196 url))
197 (list callback cbargs))))
1b6dc56 @ruediger initial release
authored Nov 30, 2009
198
199 ;;;###autoload
99636ce @ruediger private flag now behaves similar to sync flag
authored Nov 30, 2009
200 (defun* codepad-paste-buffer (&optional
166614f @ruediger added more fixes from thomas001.
authored Nov 30, 2009
201 (private 'check-custom)
202 callback cbargs)
203 "Paste buffer to codepad.org. See `codepad-paste-region'."
1b6dc56 @ruediger initial release
authored Nov 30, 2009
204 (interactive)
166614f @ruediger added more fixes from thomas001.
authored Nov 30, 2009
205 (codepad-paste-region (point-min) (point-max) private callback cbargs))
1b6dc56 @ruediger initial release
authored Nov 30, 2009
206
dff74d7 @ruediger implemented codepad-fetch-code
authored Nov 30, 2009
207 (defconst +codepad-mime-to-mode+ '(("c++src" . c++-mode)
208 ("csrc" . c-mode)
2864fb8 @ruediger added the rest of the mode detection
authored Nov 30, 2009
209 ("dsrc" . d-mode)
210 ("haskell" . haskell-mode)
211 ("lua" . lua-mode)
212 ("ocaml" . ocaml-mode)
213 ("php" . php-mode)
214 ("perl" . perl-mode)
215 ("python" . python-mode)
216 ("ruby" . ruby-mode)
217 ("scheme" . scheme-mode)
218 ("tcl" . tcl-mode))
dff74d7 @ruediger implemented codepad-fetch-code
authored Nov 30, 2009
219 "MIME text/x-... to emacs mode.")
220
a051b66 @ruediger cleaned up fetch-code (don't parse headers with regex use local vars)
authored Nov 30, 2009
221 (defvar url-http-content-type)
222
321f7db @ruediger set codepad-id var if fetched
authored Nov 30, 2009
223 (defvar codepad-id nil "ID on Codepad or nil. Buffer local.")
224
1b6dc56 @ruediger initial release
authored Nov 30, 2009
225 ;;;###autoload
dff74d7 @ruediger implemented codepad-fetch-code
authored Nov 30, 2009
226 (defun codepad-fetch-code (id &optional buffer-name)
227 "Fetch code from codepad.org.
228 Argument ID is the codepad id and
229 optional argument is the BUFFER-NAME where to write."
230 (interactive "sCodepad ID: ")
231 (let* ((just-id (replace-regexp-in-string "^.*/" "" id)) ; strip http://...
232 (buffer-name (or buffer-name (format "*codepad %s*" just-id)))
233 (url (concat +codepad-url+ "/" just-id "/raw"))
234 (buffer (get-buffer buffer-name)))
05f4800 @ruediger fetch async
authored Nov 30, 2009
235 (if (bufferp buffer)
236 (pop-to-buffer buffer)
321f7db @ruediger set codepad-id var if fetched
authored Nov 30, 2009
237
05f4800 @ruediger fetch async
authored Nov 30, 2009
238 (message "Fetching %s from Codepad" just-id)
239 (url-retrieve url
240 (lambda (status buffer-name just-id)
241 (let ((err (plist-get status :error)))
242 (when err
243 (signal (car err) (cdr err))))
244 (rename-buffer buffer-name t)
245
246 ;; set codepad-id to the id
247 (make-local-variable 'codepad-id)
248 (setq codepad-id just-id)
321f7db @ruediger set codepad-id var if fetched
authored Nov 30, 2009
249
05f4800 @ruediger fetch async
authored Nov 30, 2009
250 (goto-char (point-min))
251 (re-search-forward "\n\n") ; Find end of Headers
252 (let ((header-end (point)))
253 (goto-char (point-min))
254 ;; Determine and set mode
255 (when (and codepad-autoset-mode
256 url-http-content-type
257 (string-match "text/x-\\([^;[:space:]]*\\)"
258 url-http-content-type))
259 (let ((mode
260 (cdr (assoc
261 (match-string 1 url-http-content-type)
262 +codepad-mime-to-mode+))))
263 (when mode
264 (funcall mode))))
265 ;; Delete Headers
266 (delete-region (point-min) header-end)
267 (set-buffer-modified-p nil)
268 (pop-to-buffer (current-buffer))))
269 (list buffer-name just-id)))))
189d4a2 @ruediger added missing provide
authored Nov 30, 2009
270
271 (provide 'codepad)
272 ;;; codepad.el ends here
Something went wrong with that request. Please try again.