(require 'url)
(require 'htmlize nil t)
(defvar scpaste-html-converter
(if (featurep 'htmlize)
'htmlize-buffer
'htmlfontify-buffer)
"Name of the function to use to generate the HTML output.
By default, it will try to use `htmlize-buffer' from htmlize, and
will fall back to `htmlfontify-buffer' from Emacs's `htmlfontify'
if htmlize is not available.")
(defvar scpaste-scp-port
nil)
(defvar scpaste-scp
"scp"
"The scp program to use.")
(defvar scpaste-ssh
"ssh"
"The ssh program to use when running remote shell commands.")
(defvar scpaste-http-destination
"https://p.hagelb.org"
"Publicly-accessible (via HTTP) location for pasted files.")
(defvar scpaste-scp-destination
"p.hagelb.org:p.hagelb.org"
"SSH-accessible directory corresponding to `scpaste-http-destination'.
You must have write access to this directory via `scp'.")
(defvar scpaste-scp-pubkey
nil
"Identity file for the server.
Corresponds to ssh’s `-i` option Example: \"~/.ssh/id.pub\".
It's better to set this in ~/.ssh/config than to use this setting.")
(defvar scpaste-user-name
nil
"Name displayed under the paste.")
(defvar scpaste-user-address
nil
"Link to the user’s homebase (can be a mailto:).")
(defvar scpaste-make-name-function
'scpaste-make-name-from-buffer-name
"The function used to generate file names, unless the user provides one.")
(defvar scpaste-el-location (replace-regexp-in-string "\.elc$" ".el"
(or load-file-name
(buffer-file-name))))
(defun scpaste-footer ()
"HTML message to place at the bottom of each file."
(concat "<p style='font-size: 8pt; font-family: monospace; "
(mapconcat (lambda (c) (concat c "-select: none"))
'("-moz-user" "-webkit-user" "-ms-user" "user") "; ")
"'>Generated by "
(let ((user (or scpaste-user-name user-full-name)))
(if scpaste-user-address
(concat "<a href='" scpaste-user-address "'>" user "</a>")
user))
" using <a href='https://p.hagelb.org'>scpaste</a> at %s. "
(cadr (current-time-zone)) ". (<a href='%s'>original</a>)</p>"))
(defun scpaste-read-name (&optional suffix)
"Read the paste name from the minibuffer.
Defaults to the return value of `scpaste-make-name-function'
with SUFFIX as argument."
(let* ((default (funcall scpaste-make-name-function suffix))
(input (read-from-minibuffer (format "Name: (defaults to %s) "
default))))
(if (equal "" input) default input)))
(defun scpaste-make-name-from-buffer-name (&optional suffix)
"Make a name from buffer name and extension.
If non-nil, SUFFIX is inserted between name and extension."
(concat (file-name-sans-extension (buffer-name))
suffix
(file-name-extension (buffer-name) t)))
(defun scpaste-make-name-from-timestamp (&optional _)
"Make a name from current timestamp and current buffer's extension."
(concat (format-time-string "%s") (file-name-extension (buffer-name) t)))
(defun scpaste (original-name)
"Paste the current buffer via `scp' to `scpaste-http-destination'.
If ORIGINAL-NAME is an empty string, then the buffer name is used
for the file name."
(interactive (list (scpaste-read-name)))
(let* ((b (generate-new-buffer (generate-new-buffer-name "scpaste")))
(pre-hl-line (and (featurep 'hl-line) hl-line-mode
(progn (hl-line-mode -1) t)))
(hb (funcall scpaste-html-converter))
(name (replace-regexp-in-string "[/\\%*:|\"<> ]+" "_"
original-name))
(full-url (concat scpaste-http-destination
"/" (url-hexify-string name) ".html"))
(tmp-file (concat temporary-file-directory name))
(tmp-hfile (concat temporary-file-directory name ".html")))
(when pre-hl-line
(hl-line-mode 1))
(save-excursion
(copy-to-buffer b (point-min) (point-max))
(switch-to-buffer b)
(write-file tmp-file)
(kill-buffer b)
(switch-to-buffer hb)
(goto-char (point-min))
(search-forward "</body>\n</html>")
(insert (format (scpaste-footer)
(current-time-string)
(substring full-url 0 -5)))
(write-file tmp-hfile)
(kill-buffer hb))
(let* ((identity (if scpaste-scp-pubkey
(concat "-i " scpaste-scp-pubkey) ""))
(port (if scpaste-scp-port (concat "-P " scpaste-scp-port)))
(invocation (concat scpaste-scp " -q " identity " " port))
(command (concat invocation " " tmp-file " " tmp-hfile " "
scpaste-scp-destination "/"))
(error-buffer "*scp-error*")
(retval (shell-command command nil error-buffer))
(select-enable-primary t))
(delete-file tmp-file)
(delete-file tmp-hfile)
(if (= retval 0)
(progn (kill-new full-url)
(message "Pasted to %s (on kill ring)" full-url))
(pop-to-buffer error-buffer)
(help-mode-setup)))))
(defun scpaste-region (name)
"Paste the current region via `scpaste'.
NAME is used for the file name."
(interactive (list (scpaste-read-name (format "-%s-%s" (region-beginning)
(region-end)))))
(let ((region-contents (buffer-substring (mark) (point))))
(with-temp-buffer
(insert region-contents)
(scpaste name))))
(defun scpaste-index ()
"Generate an index of all existing pastes on server on the splash page."
(interactive)
(let* ((dest-parts (split-string scpaste-scp-destination ":"))
(files (shell-command-to-string (concat scpaste-ssh " "
(car dest-parts) " ls "
(cadr dest-parts))))
(file-list (split-string files "\n")))
(save-excursion
(with-temp-buffer
(insert-file-contents scpaste-el-location)
(goto-char (point-min))
(search-forward ";;; Commentary")
(forward-line -1)
(insert "\n;;; Pasted Files\n\n")
(dolist (file file-list)
(when (and (string-match "\\.html$" file)
(not (string-match "private" file)))
(insert (concat ";; * <" scpaste-http-destination "/" file ">\n"))))
(emacs-lisp-mode)
(if (fboundp 'font-lock-ensure)
(progn (font-lock-mode nil)
(font-lock-ensure)
(jit-lock-mode t))
(with-no-warnings (font-lock-fontify-buffer)))
(rename-buffer "SCPaste")
(write-file (concat temporary-file-directory "scpaste-index"))
(scpaste "index")))))
(provide 'scpaste)