Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
(require 'org)
(require 'url)
(require 'htmlize)
(defvar s3paste-http-destination
"http://p.hagelb.org"
"Publicly-accessible (via HTTP) location for pasted files.")
(defvar s3paste-user-address
nil
"Link to the user’s homebase (can be a mailto:).")
(defvar s3paste-user-name
nil
"Optional name to display in footer.
Will default to `user-full-name`.")
(defvar s3paste-bucket-name
nil
"The s3 bucket name.")
(defun s3paste-footer ()
"HTML message to place at the bottom of each file."
(concat "<p style='font-size: 8pt; font-family: monospace;'>Generated by "
(let ((user (or s3paste-user-name user-full-name)))
(if s3paste-user-address
(concat "<a href='" s3paste-user-address "'>" user "</a>")
user))
" using <a href='http://blog.untrod.com/s3paste'>s3paste</a> at %s. "
(cadr (current-time-zone)) ". (<a href='%s'>original</a>)</p>"))
;; From https://www.emacswiki.org/emacs/misc-cmds.el
;; Candidate as a replacement for `kill-buffer', at least when used interactively.
;; For example: (define-key global-map [remap kill-buffer] 'kill-buffer-and-its-windows)
;;
;; We cannot just redefine `kill-buffer', because some programs count on a
;; specific other buffer taking the place of the killed buffer (in the window).
;;;###autoload
(defun kill-buffer-and-its-windows (buffer)
"Kill BUFFER and delete its windows. Default is `current-buffer'.
BUFFER may be either a buffer or its name (a string)."
(interactive (list (read-buffer "Kill buffer: " (current-buffer) 'existing)))
(setq buffer (get-buffer buffer))
(if (buffer-live-p buffer) ; Kill live buffer only.
(let ((wins (get-buffer-window-list buffer nil t))) ; On all frames.
(when (and (buffer-modified-p buffer)
(fboundp '1on1-flash-ding-minibuffer-frame))
(1on1-flash-ding-minibuffer-frame t)) ; Defined in `oneonone.el'.
(when (kill-buffer buffer) ; Only delete windows if buffer killed.
(dolist (win wins) ; (User might keep buffer if modified.)
(when (window-live-p win)
;; Ignore error, in particular,
;; "Attempt to delete the sole visible or iconified frame".
(condition-case nil (delete-window win) (error nil))))))
(when (called-interactively-p 'any)
(error "Cannot kill buffer. Not a live buffer: `%s'" buffer))))
;;;###autoload
(defun do-s3paste (original-name exporter)
"Paste the current buffer via `s3cmd' to `s3paste-http-destination'.
If ORIGINAL-NAME is an empty string, then the buffer name is used
for the file name. EXPORTER is the function to generate the html."
(interactive "MName (defaults to buffer name): ")
(let* ((b (generate-new-buffer (generate-new-buffer-name "b")))
(original-buffer (current-buffer))
(name (replace-regexp-in-string "[/\\%*:|\"<> ]+" "_"
(if (equal "" original-name)
(buffer-name)
original-name)))
(hb (funcall exporter))
(full-url (concat s3paste-http-destination
"/" (url-hexify-string name) ".html"))
(tmp-file (concat temporary-file-directory name))
(tmp-hfile (concat temporary-file-directory name ".html")))
;; Save the files (while adding a footer to html file)
(save-excursion
(switch-to-buffer original-buffer)
(copy-to-buffer b (point-min) (point-max))
(switch-to-buffer b)
(write-file tmp-file)
(kill-buffer-and-its-windows b)
(switch-to-buffer hb)
(goto-char (point-min))
(search-forward "</body>\n</html>")
(insert (format (s3paste-footer)
(current-time-string)
(substring full-url 0 -5)))
(write-file tmp-hfile)
(kill-buffer-and-its-windows hb))
(let* ((invocation "s3cmd put")
(command-1 (concat invocation " " tmp-file " s3://" s3paste-bucket-name))
(command-2 (concat invocation " " tmp-hfile " s3://" s3paste-bucket-name)))
(let* ((error-buffer "*s3p-error*")
(retval (+
(with-temp-message
(format "Executing %s" command-1)
(shell-command command-1 nil error-buffer))
(with-temp-message
(format "Executing %s" command-2)
(shell-command command-2 nil error-buffer))))
(x-select-enable-primary t))
(delete-file tmp-file)
(delete-file tmp-hfile)
;; Notify user and put the URL on the kill ring
(if (= retval 0)
(progn (kill-new full-url)
(message "Pasted to %s (on kill ring)" full-url))
(progn
(pop-to-buffer error-buffer)
(help-mode-setup)))))))
;;;###autoload
(defun s3paste (original-name)
(interactive "MName (defaults to buffer name): ")
(do-s3paste original-name 'htmlize-buffer))
;;;###autoload
(defun s3paste-org (original-name)
(interactive "MName (defaults to buffer name): ")
(do-s3paste original-name 'org-html-export-as-html))
;;;###autoload
(defun s3paste-region (name)
"Paste the current region via `s3paste'.
NAME is used for the file name."
(interactive "MName: ")
(let ((region-contents (buffer-substring (mark) (point))))
(with-temp-buffer
(insert region-contents)
(s3paste name))))
(provide 's3paste)
;;; s3paste.el ends here
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment