git on!
This commit is contained in:
commit
ca44c445ee
154
emacs-upload.el
Normal file
154
emacs-upload.el
Normal file
@ -0,0 +1,154 @@
|
||||
;;; emacs-upload.el --- Upload regions, buffers, and files to various hosts. -*- lexical-binding: t; -*-
|
||||
|
||||
;;; emacs-upload - Upload the region, buffer, or file to various hosts
|
||||
;;; Copyright (C) <2019,2020> <zdm@cock.li>
|
||||
|
||||
;;; This program is free software: you can redistribute it and/or
|
||||
;;; modify it under the terms of the GNU Affero General Public License
|
||||
;;; v3.0 as published by the Free Software Foundation.
|
||||
|
||||
;;; This program is distributed in the hope that it will be useful, but
|
||||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
;;; Affero General Public License for more details.
|
||||
|
||||
;;; You should have received a copy of the GNU Affero General Public License
|
||||
;;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Dependencies: cURL, cl, json
|
||||
|
||||
;;; _Usage_
|
||||
;;;
|
||||
;;; Place emacs-upload.el in your `load-path' and load the package:
|
||||
;;;
|
||||
;;; (require 'emacs-upload)
|
||||
;;;
|
||||
;;; Bind the interactive function `emacs-upload' to some key:
|
||||
;;;
|
||||
;;; (global-set-key (kbd "C-c e") 'emacs-upload)
|
||||
;;;
|
||||
;;; Alternatively, with `use-package' you can easily bind and set a default host.
|
||||
;;;
|
||||
;;; (use-package emacs-upload
|
||||
;;; :demand t
|
||||
;;; :bind
|
||||
;;; ("C-c e" . emacs-upload)
|
||||
;;; :config
|
||||
;;; (emacs-upload/set-host "ix"))
|
||||
|
||||
;;; `emacs-upload/set-host' is also an interactive command, so you can
|
||||
;;; change your host on the fly.
|
||||
|
||||
;;; To upload the region, simply select the region and call emacs-upload. To
|
||||
;;; upload the whole buffer, have no region selected and call emacs-upload. For
|
||||
;;; a file, use the universal argument `C-u' before calling emacs-upload.
|
||||
|
||||
(require 'cl)
|
||||
(require 'json)
|
||||
|
||||
(defcustom emacs-upload/host '("http://w1r3.net" "upload=@%s")
|
||||
"Current host to upload to.")
|
||||
|
||||
(defcustom emacs-upload/hosts '(("w1r3" . ("https://w1r3.net" "upload=@%s"))
|
||||
("ix" . ("http://ix.io" "f:1=@%s"))
|
||||
("0x0" . ("https://0x0.st" "file=@%s"))
|
||||
("sprunge" . ("http://sprunge.us" "sprunge=@%s"))
|
||||
("youdieifyou.work" . ("http://youdieifyou.work/upload.php" "files[]=@%s"))
|
||||
("catbox" . ("https://catbox.moe/user/api.php" "reqtype=fileupload" "fileToUpload=@%s"))
|
||||
("fiery" . ("https://safe.fiery.me/api/upload" "files[]=@%s"))
|
||||
("dmca.gripe" . ("https://dmca.gripe/api/upload" "files[]=@%s")))
|
||||
"List of hosts you can set emacs-upload/host to.")
|
||||
|
||||
(defun emacs-upload/buffer-list ()
|
||||
"Return a list consisting of the minimum and maximum point values."
|
||||
(list (point-min) (point-max)))
|
||||
|
||||
(defun emacs-upload/region-list ()
|
||||
"Return a list consisting of the beginning and end of the active region."
|
||||
(list (region-beginning) (region-end)))
|
||||
|
||||
(defun emacs-upload/make-temp-file (file-name)
|
||||
"Return a string of a temporarily created file with the suffix
|
||||
either being the filename's extension, if it exists, or `.txt'
|
||||
for buffers not associated with a file."
|
||||
(make-temp-file "emacs-upload" nil (if file-name (file-name-extension file-name t)
|
||||
".txt")))
|
||||
|
||||
(defun emacs-upload/write-content-to-file (content file)
|
||||
"Write content to file, content being a list of the beginning
|
||||
and ending points."
|
||||
(apply 'write-region (append content (list file))))
|
||||
|
||||
(defun emacs-upload/list-curl-forms (file)
|
||||
"Generate a list curl forms"
|
||||
(if (cddr emacs-upload/host)
|
||||
(let* ((forms (mapcan (lambda (form) (list "-F" form)) (rest emacs-upload/host)))
|
||||
(file-form (car (last forms))))
|
||||
(append (butlast forms)
|
||||
(list (format file-form file) (first emacs-upload/host))))
|
||||
(list "-F" (format (second emacs-upload/host) file) (first emacs-upload/host))))
|
||||
|
||||
(defun emacs-upload/start-curl-process (file)
|
||||
"Start curl process"
|
||||
(apply 'start-process "emacs-upload" nil "curl" (emacs-upload/list-curl-forms file)))
|
||||
|
||||
(defun emacs-upload/pomf-parse (json)
|
||||
"Parse json and return a URL string or nil if an error occurred"
|
||||
(let* ((pretty-json (json-read-from-string json))
|
||||
(success (equal (cdr (assoc 'success pretty-json)) t)))
|
||||
(if success (cdr (assoc 'url (aref (cdr (cadr pretty-json)) 0)))
|
||||
(let ((inhibit-message t))
|
||||
(mapc (lambda (desc)
|
||||
(message "%s: %s" (car desc) (cdr desc)))
|
||||
pretty-json)
|
||||
nil))))
|
||||
|
||||
(defun emacs-upload/filter (process output)
|
||||
"Determine whether or not the output is json, either parsing
|
||||
the json or simply stripping the newlines from output and killing
|
||||
that."
|
||||
(if (string-match "{" output)
|
||||
(let ((result (emacs-upload/pomf-parse output)))
|
||||
(if result (message "File uploaded at %s and saved to your kill-ring."
|
||||
(kill-new result))
|
||||
(message "Error while uploading file. See *Messages* buffer for more information.")))
|
||||
(if (string-match "http" output)
|
||||
(message "File uploaded at %s and saved to your kill ring."
|
||||
(kill-new (replace-regexp-in-string "\n$" "" output)))
|
||||
(progn
|
||||
(let ((inhibit-message t))
|
||||
(message output)
|
||||
nil)
|
||||
(message "Error while uploading file. See *Messages* buffer for more information")))))
|
||||
|
||||
;;;###autoload
|
||||
(defun emacs-upload/set-host (host)
|
||||
"Set host. Call this interactively or as function from your
|
||||
init to set a default from the list of available hosts, such
|
||||
as: (emacs-upload/set-host \"ix\")"
|
||||
(interactive
|
||||
(list (completing-read "Set the host: " (mapcar 'first emacs-upload/hosts)
|
||||
nil t)))
|
||||
(setq emacs-upload/host (cdr (assoc host emacs-upload/hosts)))
|
||||
(message "emacs-upload/host is now set to %s" host))
|
||||
|
||||
;;;###autoload
|
||||
(defun emacs-upload (&optional arg)
|
||||
"Upload the region if selected, the buffer if it is not, or if
|
||||
called with ARG (C-u) select a file."
|
||||
(interactive "P")
|
||||
(if (executable-find "curl")
|
||||
(let ((file nil))
|
||||
(cond ((and (not arg) (region-active-p))
|
||||
(setq file (emacs-upload/make-temp-file nil))
|
||||
(emacs-upload/write-content-to-file (emacs-upload/region-list) file))
|
||||
(arg (setq file (read-file-name "File to upload: ")))
|
||||
(t (setq file (emacs-upload/make-temp-file nil))
|
||||
(emacs-upload/write-content-to-file (emacs-upload/buffer-list) file)))
|
||||
(message "Uploading...")
|
||||
(set-process-filter (emacs-upload/start-curl-process file) 'emacs-upload/filter))
|
||||
(message "cURL not found")))
|
||||
|
||||
(provide 'emacs-upload)
|
||||
|
||||
;;; emacs-upload.el ends here
|
||||
Reference in New Issue
Block a user