chrisclark · July 26, 2016 23:09 · Jul 26, 2016
diff --git a/s3paste.el b/s3paste.el
@@ -0,0 +1,138 @@
+(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