s3paste.el

(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