zqso

neopastebin.el

Aug 21st, 2026
54
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Lisp 27.05 KB | None | 0 0
  1. ;;; neopastebin.el --- pastebin.com interface to emacs
  2.  
  3. ;;; Copyright (C) 2013 by Daniel Hilst <danielhilst at gmail.com>
  4.  
  5. ;;; This program is free software; you can redistribute it and/or modify
  6. ;;; it under the terms of the GNU General Public License as published by
  7. ;;; the Free Software Foundation; either version 2, or (at your option)
  8. ;;; any later version.
  9.  
  10. ;;; This program is distributed in the hope that it will be useful,
  11. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13. ;;; GNU General Public License for more details.
  14.  
  15. ;;; You should have received a copy of the GNU General Public License
  16. ;;; along with this program; see the file COPYING.  If not, write to the
  17. ;;; Free Software Foundation, Inc.,   51 Franklin Street, Fifth Floor,
  18. ;;; Boston, MA  02110-1301  USA
  19.  
  20. ;;; Besides being a new interface, some parts were borrowed from old
  21. ;;; interface so I think is fair put the names here.
  22. ;;; Copyright (C) 2008 by Nic Ferrier <[email protected]>
  23. ;;; Copyright (C) 2010 by Ivan Korotkov <[email protected]>
  24. ;;; Copyright (C) 2012 by Filonenko Michael <[email protected]>
  25.  
  26. ;;;
  27. ;;; Commentary:
  28. ;;;
  29.  
  30. ;;;
  31. ;;; USAGE:
  32. ;;;
  33. ;;;     LOGIN
  34. ;;;     ~~~~~
  35. ;;;
  36. ;;; Puts this on your .emacs file
  37. ;;;
  38. ;;;   (let ((credentials (auth-source-user-and-password "pastebin.com")))
  39. ;;;     (pastebin-create-login :username "YOURUSER"
  40. ;;;                            :dev-key (car credentials)
  41. ;;;                            :password (cadr credentials)))
  42. ;;;
  43. ;;; Login will only ocurr when you try to paste something or
  44. ;;; list your pastes. So is save to put this on your .emacs file
  45. ;;; without need to wait emacs connect to pastebin on each startup.
  46. ;;;
  47. ;;;
  48. ;;; -*- SECURITY REMINDER -*-
  49. ;;;
  50. ;;; It is NOT recommended to write "dev-key/password" to your .emacs file. You
  51. ;;; should use `auth-source' or `auth-source-pass' package(s) to store and
  52. ;;; read your "dev-key/password" securely.
  53. ;;;
  54. ;;; Since pastebin uses https instead http, your "dev-key/password" are secure
  55. ;;; during transmission on network.
  56. ;;;
  57. ;;;
  58. ;;;     LISTING
  59. ;;;     ~~~~~~~
  60. ;;;
  61. ;;; M-x pastebin-list-buffer-refresh -> Fetch and list pastes on "list buffer"
  62. ;;;
  63. ;;; After logged you can list your pastes with command `pastebin-list-buffer-refresh'.
  64. ;;;
  65. ;;; Here is a list of keybinds from list buffer
  66. ;;;
  67. ;;; RET -> fetch paste and switch to it
  68. ;;; r ->   refresh list and list buffer
  69. ;;; d ->   delete paste
  70. ;;; t ->   order by title
  71. ;;; D ->   order by date
  72. ;;; f ->   order by format
  73. ;;; k ->   order by key
  74. ;;; p ->   order by private
  75. ;;;
  76. ;;;
  77. ;;;     CREATING NEW PASTE
  78. ;;;     ~~~~~~~~~~~~~~~~~~
  79. ;;;
  80. ;;; M-x pastebin-new -> will create a new paste from current buffer
  81. ;;;
  82. ;;; The name of the paste is given from current buffer name
  83. ;;; The format from buffers major mode
  84. ;;; Prefix argument makes private
  85. ;;;
  86.  
  87. ;;;
  88. ;;; Naming convention:
  89. ;;;
  90. ;;; pastebin-- prefix for internal stuff
  91. ;;; pastebin- prefix for user interface and customs
  92. ;;;
  93. ;;;
  94. ;;; DEPENDENCIES:
  95. ;;;
  96. ;;; eieio.el
  97. ;;; wid-edit
  98. ;;;
  99.  
  100. ;;;
  101. ;;; Codes:
  102. ;;;
  103. (require 'eieio)
  104. (require 'wid-edit)
  105.  
  106. (defgroup pastebin nil
  107.   "Pastebin -- pastebin.com client"
  108.   :tag "Pastebin"
  109.   :group 'tools)
  110.  
  111. ;; Customs
  112.  
  113. (defcustom pastebin-default-paste-list-limit 100
  114.   "The number of pastes to retrieve by default"
  115.   :type 'number
  116.   :group 'pastebin)
  117.  
  118. (defcustom pastebin-post-request-login-url "https://pastebin.com/api/api_login.php"
  119.   "Login url"
  120.   :type 'string
  121.   :group 'pastebin)
  122.  
  123. (defcustom pastebin-post-request-paste-url "https://pastebin.com/api/api_post.php"
  124.   "Paste url"
  125.   :type 'string
  126.   :group 'pastebin)
  127.  
  128. ;; Global variables
  129.  
  130. (defvar pastebin--mode-map nil
  131.   "The pastebin keymap.")
  132. (unless pastebin--mode-map
  133.   (setq pastebin--mode-map (make-sparse-keymap))
  134.   (define-key pastebin--mode-map (kbd "C-x p u") 'pastebin-show-url))
  135.  
  136. (define-minor-mode pastebin-mode
  137.   "Pastebin buffer mode, used to upload pastes automatically with S-C-x C-s"
  138.   :lighter " pastebin"
  139.   :group 'pastebin
  140.   :keymap pastebin--mode-map)
  141.  
  142. (defvar pastebin--type-assoc
  143.   '((actionscript-mode . " actionscript")
  144.     (ada-mode . "ada")
  145.     (asm-mode . "asm")
  146.     (sh-mode . "bash")
  147.     (autoconf-mode . "bash")
  148.     (bibtex-mode . "bibtex")
  149.     (cmake-mode . "cmake")
  150.     (c-mode . "c")
  151.     (c++-mode . "cpp")
  152.     (cobol-mode . "cobol")
  153.     (conf-colon-mode . "properties")
  154.     (conf-javaprop-mode . "properties")
  155.     (conf-mode . "ini")
  156.     (conf-space-mode . "properties")
  157.     (conf-unix-mode . "ini")
  158.     (conf-windows-mode . "ini")
  159.     (cperl-mode . "perl")
  160.     (csharp-mode . "csharp")
  161.     (css-mode . "css")
  162.     (delphi-mode . "delphi")
  163.     (diff-mode . "diff")
  164.     (ebuild-mode . "bash")
  165.     (eiffel-mode . "eiffel")
  166.     (emacs-lisp-mode . "lisp")
  167.     (erlang-mode . "erlang")
  168.     (erlang-shell-mode . "erlang")
  169.     (espresso-mode . "javascript")
  170.     (fortran-mode . "fortran")
  171.     (glsl-mode . "glsl")
  172.     (gnuplot-mode . "gnuplot")
  173.     (graphviz-dot-mode . "dot")
  174.     (haskell-mode . "haskell")
  175.     (html-mode . "html4strict")
  176.     (idl-mode . "idl")
  177.     (inferior-haskell-mode . "haskell")
  178.     (inferior-octave-mode . "octave")
  179.     (inferior-python-mode . "python")
  180.     (inferior-ruby-mode . "ruby")
  181.     (java-mode . "java")
  182.     (js2-mode . "javascript")
  183.     (jython-mode . "python")
  184.     (latex-mode . "latex")
  185.     (lisp-mode . "lisp")
  186.     (lisp-interaction-mode . "lisp")
  187.     (lua-mode . "lua")
  188.     (makefile-mode . "make")
  189.     (makefile-automake-mode . "make")
  190.     (makefile-gmake-mode . "make")
  191.     (makefile-makepp-mode . "make")
  192.     (makefile-bsdmake-mode . "make")
  193.     (makefile-imake-mode . "make")
  194.     (matlab-mode . "matlab")
  195.     (nxml-mode . "xml")
  196.     (oberon-mode . "oberon2")
  197.     (objc-mode . "objc")
  198.     (ocaml-mode . "ocaml")
  199.     (octave-mode . "matlab")
  200.     (pascal-mode . "pascal")
  201.     (perl-mode . "perl")
  202.     (php-mode . "php")
  203.     (plsql-mode . "plsql")
  204.     (po-mode . "gettext")
  205.     (prolog-mode . "prolog")
  206.     (python-2-mode . "python")
  207.     (python-3-mode . "python")
  208.     (python-basic-mode . "python")
  209.     (python-mode . "python")
  210.     (ruby-mode . "ruby")
  211.     (scheme-mode . "lisp")
  212.     (shell-mode . "bash")
  213.     (smalltalk-mode . "smalltalk")
  214.     (sql-mode . "sql")
  215.     (tcl-mode . "tcl")
  216.     (visual-basic-mode . "vb")
  217.     (xml-mode . "xml")
  218.     (yaml-mode . "properties")
  219.     (text-mode . "text"))
  220.   "Alist composed of major-mode names and corresponding pastebin highlight formats.")
  221.  
  222. (defvar pastebin--default-user nil
  223.   "The default user begin used")
  224.  
  225. (defvar pastebin--local-buffer-paste nil
  226.   "Every pastebin buffer has a paste object associated with it")
  227. (make-variable-buffer-local 'pastebin--local-buffer-paste)
  228.  
  229. (defvar pastebin--list-buffer-user nil
  230.   "Every pastebin list buffer has a user object associated with it")
  231. (make-variable-buffer-local 'pastebin--list-buffer-user)
  232.  
  233. (defvar pastebin--list-map
  234.   (let ((map (make-sparse-keymap)))
  235.     (define-key map (kbd "d") 'pastebin-delete-paste-at-point)
  236.     (define-key map (kbd "r") 'pastebin-list-buffer-refresh)
  237.     (define-key map (kbd "f") 'pastebin-list-buffer-refresh-sort-by-format)
  238.     (define-key map (kbd "t") 'pastebin-list-buffer-refresh-sort-by-title)
  239.     (define-key map (kbd "k") 'pastebin-list-buffer-refresh-sort-by-key)
  240.     (define-key map (kbd "D") 'pastebin-list-buffer-refresh-sort-by-date)
  241.     (define-key map (kbd "p") 'pastebin-list-buffer-refresh-sort-by-private)
  242.     map)
  243.   "Key map for pastebin list buffer")
  244.  
  245. (defconst pastebin--raw-paste-url "http://pastebin.com/raw.php?i="
  246.   "Concatenate this with paste key to get the raw paste")
  247.  
  248. ;;
  249. ;; EIEIO Layer
  250. ;;
  251.  
  252. ;; PASTE-USER class
  253.  
  254. (defclass pastebin--paste-user ()
  255.   ((dev-key :initarg :dev-key "Your developer key from http://pastebin.com/api")
  256.    (usr-key :initarg :usr-key "Your user key, retrived from pastebin")
  257.    (password :initarg :password "Your password, clear text honey!!")
  258.    (username :initarg :username "Your username")
  259.    (paste-list :initarg :paste-list "The list of pastes for this user")
  260.    (list-buffer :initarg :list-buffer "Done by do-list-buffer")
  261.    (sort-by :initarg :sort-by "Order to sort :paste-list")
  262.   )
  263.   "Class representing a pastebin.com user")
  264.  
  265. (cl-defmethod is-logged ((user pastebin--paste-user))
  266.   "Return true if user is logged in"
  267.   (slot-boundp user :usr-key))
  268.  
  269. (cl-defmethod fetch-list-xml ((user pastebin--paste-user))
  270.   "Fetch the list of pastes as xml, and return that buffer"
  271.   (let* ((params (concat "api_dev_key=" (oref user dev-key)
  272.              "&api_user_key=" (oref user usr-key)
  273.              "&api_results_limit=" (format "%d" pastebin-default-paste-list-limit)
  274.              "&api_option=list")))
  275.     (with-current-buffer (pastebin--url-retrieve-synchronously pastebin-post-request-paste-url
  276.                                    "POST"
  277.                                    params)
  278.       (pastebin--strip-CRs)
  279.       (goto-char (point-min))
  280.       (current-buffer)
  281.       )))
  282.  
  283. (cl-defmethod refresh-paste-list ((user pastebin--paste-user))
  284.   "Set/Refresh paste-list attr to the list of paste objects retrieved from pastebin.com"
  285.   (oset user :paste-list nil)
  286.   (with-current-buffer (fetch-list-xml user)
  287.     (goto-char (point-min))
  288.     (let ((i (point-min))
  289.       plist)
  290.       (while (re-search-forward "</paste>" nil t)
  291.     (let ((paste-sexp (xml-parse-region i (point)))
  292.           p)
  293.       (setq i (point))
  294.       (condition-case err
  295.           (progn
  296.         (setq p (pastebin--sexp-to-paste paste-sexp))
  297.         (oset p :user user)
  298.         (oset p :last-fetched (float-time))
  299.         (setq plist (append plist (list p))))
  300.         (wrong-type-argument
  301.          (error "Error while creating paste object on `refresh-paste-list' %s" err)
  302.          (debug)))
  303.       )
  304.     (oset user :paste-list plist)
  305.     )
  306.       )
  307.     )
  308.   )
  309.  
  310. (defmacro pastebin--sort-by-string-attr (user attr)
  311.   "sort :paste-list by `attr' in reverse order"
  312.   `(progn
  313.      (unless (keywordp ,attr)
  314.        (error "pastebin--sort-by-stirng-attr attr is not a keyword"))
  315.  
  316.      (unless (member ,attr '(:key :title :format_long :format_short :url :date :private))
  317.       (error "pastebin--sort-by-string-attr attr is not in '(:key :title :format_long :format_short :url)"))
  318.  
  319.      (oset ,user :paste-list (sort (oref ,user :paste-list) (lambda (p1 p2)
  320.                                                           (string< (downcase (oref p1 ,attr))
  321.                                                                    (downcase (oref p2 ,attr))))))
  322.      )
  323.   )
  324.  
  325. (cl-defmethod do-list-buffer ((user pastebin--paste-user))
  326.   "Create a buffer with a list of pastes and return it
  327. Some keybinds are setted"
  328.   (unless (is-logged user)
  329.     (error "do-list-buffer called with unloged user"))
  330.  
  331.   (unless (slot-boundp user :list-buffer)
  332.     (oset user :list-buffer (format "Pastebin %s pastes" (oref user :username))))
  333.  
  334.   (unless (get-buffer (oref user :list-buffer))
  335.     (generate-new-buffer (oref user :list-buffer))
  336.     (message "%s buffer created" (oref user :list-buffer)))
  337.  
  338.   (let ((inhibit-read-only t)
  339.     old-point)
  340.     (with-current-buffer (get-buffer (oref user :list-buffer))
  341.  
  342.       (setq old-point (point))
  343.  
  344.       (erase-buffer)
  345.  
  346.       (widget-minor-mode 1)
  347.       (use-local-map pastebin--list-map)
  348.  
  349.       (setq pastebin--list-buffer-user user)
  350.  
  351.       (widget-insert (format "%5.5s | %-8.8s | %-32.32s | %-7.7s | %-30.30s\n"
  352.                  "VIEW" "ID" "TITLE" "FORMAT" "DATE"))
  353.       (dolist (paste (oref user :paste-list))
  354.     (widget-create 'link
  355.                :notify (lambda (wid &rest ignore)
  356.                  (pastebin--fetch-paste-at-point))
  357.                :paste paste
  358.                :follow-link t
  359.                :value (format "%4.4s | %-8.8s | %-32.32s | %-7.7s | %-20.20s"
  360.                       (cond
  361.                        ((string= (oref paste :private) "0")
  362.                     "PUBL")
  363.                        ((string= (oref paste :private) "1")
  364.                     "ULST")
  365.                        ((string= (oref paste :private) "2")
  366.                     "PRIV")
  367.                        (t
  368.                     "_ERR"))
  369.                       (oref paste :key)
  370.                       (or (oref paste :title) "")
  371.                       (oref paste :format_short)
  372.                       (format-time-string "%c" (seconds-to-time (string-to-number (oref paste :date))))
  373.                       )
  374.                )
  375.  
  376.     (widget-insert "\n")
  377.     )
  378.       (widget-setup)
  379.       (goto-char (or old-point (point-min)))
  380.       (current-buffer)
  381.       ) ;; (with-current-buffer (get-buffer (oref user :list-buffer))
  382.     ) ;; (let ((inhibit-read-only t)
  383.   )
  384.  
  385. (cl-defmethod login ((user pastebin--paste-user))
  386.   "Given user and password login and sets usr-key"
  387.   (if (slot-boundp user :usr-key)
  388.       (oref user :usr-key)
  389.     (let* ((params (concat "api_dev_key=" (oref user :dev-key)
  390.                "&api_user_name=" (url-hexify-string (oref user :username))
  391.                "&api_user_password=" (url-hexify-string (oref user :password)))))
  392.  
  393.       (with-current-buffer (pastebin--url-retrieve-synchronously pastebin-post-request-login-url
  394.                                  "POST"
  395.                                  params)
  396.     (oset user :usr-key (buffer-substring-no-properties (point-min) (point-max)))))))
  397.  
  398. (cl-defmethod paste-create (buffer-data &optional unlisted)
  399.   "Create new paste to pastebin.com helper"
  400.   (unless (is-logged pastebin--default-user)
  401.     (login pastebin--default-user))
  402.   (save-excursion
  403.     (goto-char (point-min))
  404.     (pastebin-mode 1)
  405.     (let* ((lexical-binding t)
  406.        (pbuf (paste-new pastebin--default-user buffer-data unlisted))
  407.        (url (pastebin--get-pst-url pbuf))
  408.        (x-select-enable-clipboard t)
  409.        (link-point (re-search-forward "http://[A-Za-z0-9_-]+\.[A-Za-z0-9]+" nil t)))
  410.       (kill-new url)
  411.       (message "URL: %s%s" url
  412.            (if link-point
  413.            (concat (format "\nYour buffer contains an link at line %d\n" (line-number-at-pos link-point))
  414.                (format "please visit link above and fill the captcha"))
  415.          "")))))
  416.  
  417. (cl-defmethod paste-new ((user pastebin--paste-user) buffer-data &optional unlisted)
  418.   "Upload a new paste to pastebin.com"
  419.   (let* ((ptitle (buffer-name))
  420.      (pbuffer (current-buffer))
  421.      (pprivate (if unlisted "1" "0"))
  422.      (params (concat "api_dev_key=" (oref user :dev-key)
  423.              "&api_user_key=" (oref user :usr-key)
  424.              "&api_paste_name=" (url-hexify-string ptitle)
  425.              "&api_paste_format=" (url-hexify-string (pastebin--get-format-string-from-major-mode))
  426.              "&api_paste_code=" (url-hexify-string (with-current-buffer pbuffer
  427.                                  buffer-data))
  428.              "&api_option=paste"
  429.              "&api_paste_private=" pprivate)))
  430.     (with-current-buffer (pastebin--url-retrieve-synchronously pastebin-post-request-paste-url
  431.                                    "POST"
  432.                                    params)
  433.       (current-buffer))))
  434.  
  435.  
  436.  
  437. ;; PASTE CLASS
  438.  
  439. (defclass pastebin--paste ()
  440.   ((key :initarg :key)
  441.    (date :initarg :date)
  442.    (title :initarg :title)
  443.    (size :initarg :size)
  444.    (expire_date :initarg :expire_date)
  445.    (private :initarg :private)
  446.    (format_long :initarg :format_long)
  447.    (format_short :initarg :format_short)
  448.    (url :initarg :url)
  449.    (buffer :initarg :buffer)
  450.    (last-fetched :initarg :last-fetched)
  451.    (user :initarg :user :type pastebin--paste-user)
  452.    (hits :initarg :hits))
  453.   "Class representing a paste from pastebin.com
  454. The contents of paste are not stored. Instead the method
  455. `paste-fetch' fetch and retrieve the buffer with paste contents")
  456.  
  457. (cl-defmethod get-mode ((p pastebin--paste))
  458.   "return the mode from `pastebin--type-assoc'"
  459.   (if (slot-boundp p :format_short)
  460.       (car (rassoc (oref p :format_short) pastebin--type-assoc))
  461.     (error "No format short for paste %s with key %s" (oref p :title) (oref p :key))))
  462.  
  463. (cl-defmethod fetch-and-process ((p pastebin--paste))
  464.   "Fetch buffer a do needed processing before switching to it"
  465.   (with-current-buffer (paste-fetch p)
  466.     (switch-to-buffer (current-buffer))))
  467.  
  468. (cl-defmethod paste-fetch ((p pastebin--paste))
  469.   "Fetch the raw content from paste and return buffer containing"
  470.   (let* ((content-buf (pastebin--url-retrieve-synchronously (concat pastebin--raw-paste-url (oref p key))
  471.                                 "GET"
  472.                                 ""))
  473.      (inhibit-read-only t)
  474.      (pbuf (if (and (slot-boundp p :buffer)
  475.             (buffer-live-p (oref p :buffer)))
  476.            (oref p :buffer)
  477.          (oset p :buffer (get-buffer-create (oref p :title))))))
  478.     (with-current-buffer pbuf
  479.       (erase-buffer)
  480.       (insert-buffer-substring content-buf)
  481.       (pastebin--strip-paste-CRs)
  482.       (funcall (get-mode p))
  483.       (setq pastebin--local-buffer-paste p) ;; buffer local
  484.       (pastebin-mode 1)
  485.       (current-buffer))))
  486.  
  487. (cl-defmethod paste-delete ((p pastebin--paste))
  488.   "Detele paste from pastebin.com"
  489.   (unless (and (slot-boundp p :user)
  490.            (slot-boundp p :key)
  491.            (slot-boundp (oref p :user) :dev-key)
  492.            (slot-boundp (oref p :user) :usr-key))
  493.     (error "paste-delete called with ubound slot object"))
  494.  
  495.   (let* ((params (concat "api_dev_key=" (oref (oref p :user) :dev-key)
  496.              "&api_user_key=" (oref (oref p :user) :usr-key)
  497.              "&api_paste_key=" (oref p :key)
  498.              "&api_option=delete")))
  499.     (with-current-buffer (pastebin--url-retrieve-synchronously pastebin-post-request-paste-url
  500.                                    "POST"
  501.                                    params)
  502.       (buffer-string)) ;; Pastebin send somthing like paste xxx deleted
  503.     ))
  504.  
  505. ;; Local functions and helpers
  506.  
  507. (defun pastebin--get-format-string-from-major-mode ()
  508.   "Returns the format string from major mode
  509. Error if major-mode is nil"
  510.   (unless major-mode
  511.     (error "pastebin--get-format-string-from-major-mode called with nil major-mode"))
  512.   (or (cdr (assoc major-mode pastebin--type-assoc))
  513.       "text"))
  514.  
  515. (defun pastebin--sexp-get-attr-h (paste-sexp attr &optional onerror)
  516.   "Return the attribute `attr' from `paste-sexp'
  517. If onerror is given (should be a string) is used when no such attribute
  518. is found.
  519. Attributes are described here: http://pastebin.com/api#9
  520. `attr' must be a symbol
  521. Ex: (pastebin-paste-get-attr some-paste-sexp 'paste_tittle)"
  522.   (unless (symbolp attr)
  523.     (error "attr should be a symbol"))
  524.   (when (and onerror
  525.              (not (stringp onerror)))
  526.     (error "onerror should be a string"))
  527.   (let ((a (or (car (last (assoc attr (nthcdr 2 (car paste-sexp)))))
  528.                onerror)))
  529.     (unless a
  530.       (error "No attribute %s on paste sexp '%s'" attr paste-sexp))
  531.     (format "%s" a)))
  532.  
  533. (defun pastebin--strip-paste-CRs (&optional buffer)
  534.   "Get rid of CR
  535. I use this after fetching a paste to get rid of annoying ^M"
  536.   (let ((buffer (or buffer (current-buffer))))
  537.     (with-current-buffer buffer
  538.       (goto-char (point-min))
  539.       (while (re-search-forward "\r" nil t)
  540.         (replace-match ""))
  541.       buffer)))
  542.  
  543. (defun pastebin--strip-CRs (&optional buffer)
  544.   "Get rid of CRLF
  545. I need this for xml-parse-region reponse without getting
  546. a lot of spaces and CRLF on pastes sexps. See `pastebin--sexp-to-paste'"
  547.   (let ((buffer (or buffer (current-buffer))))
  548.     (with-current-buffer buffer
  549.       (goto-char (point-min))
  550.       (while (re-search-forward "\r\n" nil t)
  551.         (replace-match ""))
  552.       buffer)))
  553.  
  554. (defun pastebin--strip-http-header (&optional buffer)
  555.   "Given a buffer with an HTTP response, remove the header and return the buffer
  556. If no buffer is given current buffer is used"
  557.   (let ((buffer (or buffer (current-buffer))))
  558.     (with-current-buffer buffer
  559.       (goto-char (point-min))
  560.       (re-search-forward "\n\n")
  561.     (kill-region (point-min) (point))
  562.     buffer)))
  563.  
  564. (defun pastebin--get-paste-at-point ()
  565.   "Get the paste at point at current-buffer"
  566.   (let ((wid (widget-at)))
  567.     (if (not wid)
  568.         (error "No paste at point")
  569.       (widget-get wid :paste))))
  570.  
  571. (defun pastebin--fetch-paste-at-point ()
  572.   "Fetch and switch to paste at point"
  573.   (let ((p (pastebin--get-paste-at-point)))
  574.     (fetch-and-process p)))
  575.  
  576. (defun pastebin--sexp-to-paste (paste-sexp)
  577.   "Given and sexp returned from `xml-parse-region' on pastebin.com response, constructs and return a pastebin--paste object.
  578. See `fetch-list-xml' for more information"
  579.   (unless (consp paste-sexp)
  580.     (error "pastebin--sexp-to-paste called without cons type"))
  581.   (condition-case err
  582.       (pastebin--paste (concat "paste@" (pastebin--sexp-get-attr-h paste-sexp 'paste_key))
  583.                        :key (pastebin--sexp-get-attr-h paste-sexp 'paste_key)
  584.                        :date (pastebin--sexp-get-attr-h paste-sexp 'paste_date)
  585.                        :title (pastebin--sexp-get-attr-h paste-sexp 'paste_title "UNTITLED")
  586.                        :size (pastebin--sexp-get-attr-h paste-sexp 'paste_size)
  587.                        :expire_date (pastebin--sexp-get-attr-h paste-sexp 'paste_expire_date)
  588.                        :private (pastebin--sexp-get-attr-h paste-sexp 'paste_private)
  589.                        :format_long (pastebin--sexp-get-attr-h paste-sexp 'paste_format_long)
  590.                        :format_short (pastebin--sexp-get-attr-h paste-sexp 'paste_format_short)
  591.                        :url (pastebin--sexp-get-attr-h paste-sexp 'paste_url)
  592.                        )
  593.     ((debug error)
  594.      (error "Cant construct paste from sexp %s\nError: %s" paste-sexp err))))
  595.  
  596. (defun pastebin--url-retrieve-synchronously (url method params)
  597.   "Retrieve a buffer from pastebin, raising an error if an error ocurr"
  598.   (unless (stringp url)
  599.     (error "pastebin--url-retrieve-synchronously `url' need to be a string"))
  600.  
  601.   (unless (stringp method)
  602.     (error "pastebin--url-retrieve-synchronously `method' need to be a string"))
  603.  
  604.   (unless (stringp params)
  605.     (error "pastebin--url-retrieve-synchronously `params' need to be a string"))
  606.  
  607.   (let* ((inhibit-read-only t)
  608.          (url-request-method method)
  609.          (url-request-extra-headers
  610.           '(("Content-Type" . "application/x-www-form-urlencoded")))
  611.          (url-request-data params)
  612.          (content-buf (url-retrieve-synchronously url)))
  613.     (unless (pastebin--http-200-p content-buf) ;; check HTTP header
  614.       (when debug-on-error
  615.         (with-current-buffer (get-buffer-create "*pastebin-debug*")
  616.           (erase-buffer)
  617.           (goto-char (point-min))
  618.           (insert "Bad HTTP response below\n")
  619.           (insert-buffer-substring content-buf)))
  620.       (error (concat
  621.               "pastebin--url-retrieve-synchronously HTTP Bad response (not 200) on header\n"
  622.               (if debug-on-error
  623.                   "See header at *pastebin-debug*"
  624.                 "")))) ;; header is OK ...
  625.     (with-current-buffer content-buf
  626.       (goto-char (point-min))
  627.       (pastebin--strip-http-header)
  628.       (pastebin--error-if-bad-response (current-buffer)) ;; two `with-current-buffer' on same buffer :-/ slow
  629.       )
  630.     content-buf ;; return the buffer
  631.     ))
  632.  
  633. (defun pastebin--error-if-bad-response (buf)
  634.   "Raises a error if is a bad response from pastebin"
  635.   (unless (or (bufferp buf)
  636.               (stringp buf))
  637.     (error "pastebin--bad-presponse-p `buf' need be a buffer or a string"))
  638.  
  639.   (with-current-buffer buf
  640.     (if (or
  641.          (save-excursion
  642.            (re-search-forward "Bad API request," nil t))
  643.          (save-excursion
  644.            (re-search-forward "No pastes found." nil t))
  645.          (save-excursion
  646.            (re-search-forward "URL Post limit, maximum pastes per 24h reached" nil t)))
  647.         (error "Pastebin bad response: %s" (buffer-string))
  648.       nil)))
  649.  
  650.  
  651. (defun pastebin--http-200-p (header-buf)
  652.   "Search for HTTP 200 status on header-str - a buffer"
  653.   (unless (bufferp header-buf)
  654.     (error "pastebin--http-200-p: `header-buf' need be a buffer :/"))
  655.  
  656.   (with-current-buffer header-buf
  657.     (save-excursion
  658.       (goto-char (point-min))
  659.       (re-search-forward "HTTP.*200 OK" nil t))))
  660.  
  661. (defun pastebin--get-pst-url (buf)
  662.   "Return url string from buf"
  663.   (unless (and (or (bufferp buf)
  664.                    (stringp buf))
  665.                 (get-buffer buf))
  666.      (error (concat "pastebin--get-pst-url `buf' need\n"
  667.                     "be a existing buffer or buffer name as string")))
  668.  
  669.   (with-current-buffer buf
  670.     (save-excursion
  671.       (buffer-substring-no-properties (point-min) (point-max)))))
  672.  
  673. ;; User interface
  674.  
  675. (defun pastebin-show-url ()
  676.   "On a buffer from a fetched paste, show the url o echo area"
  677.   (interactive)
  678.   (if pastebin--local-buffer-paste
  679.       (message (format "Paste URL: %s" (oref pastebin--local-buffer-paste :url)))
  680.     (message (format "Current buffer is not a paste buffer"))))
  681.  
  682. (defun pastebin-list-buffer-refresh ()
  683.   "Refresh the list buffer screen
  684. Operates on current buffer"
  685.   (interactive)
  686.   (unless (is-logged pastebin--default-user)
  687.     (login pastebin--default-user))
  688.   (refresh-paste-list pastebin--default-user)
  689.   (switch-to-buffer (do-list-buffer pastebin--default-user))
  690.   (message "%d pastes fetched!" (length (oref pastebin--default-user :paste-list)))
  691.   )
  692.  
  693.  
  694. (defun pastebin-list-buffer-refresh-sort-by-title ()
  695.   (interactive)
  696.   (pastebin--sort-by-string-attr pastebin--default-user :title)
  697.   (switch-to-buffer (do-list-buffer pastebin--default-user))
  698.   )
  699.  
  700. (defun pastebin-list-buffer-refresh-sort-by-format ()
  701.   (interactive)
  702.   (pastebin--sort-by-string-attr pastebin--default-user :format_short)
  703.   (switch-to-buffer (do-list-buffer pastebin--default-user))
  704.   )
  705.  
  706. (defun pastebin-list-buffer-refresh-sort-by-key ()
  707.   (interactive)
  708.   (pastebin--sort-by-string-attr pastebin--default-user :key)
  709.   (switch-to-buffer (do-list-buffer pastebin--default-user))
  710.   )
  711.  
  712. (defun pastebin-list-buffer-refresh-sort-by-date ()
  713.   (interactive)
  714.   (pastebin--sort-by-string-attr pastebin--default-user :date)
  715.   (oset pastebin--default-user :paste-list (reverse (oref pastebin--default-user :paste-list)))
  716.   (switch-to-buffer (do-list-buffer pastebin--default-user))
  717.   )
  718.  
  719. (defun pastebin-list-buffer-refresh-sort-by-private ()
  720.   (interactive)
  721.   (pastebin--sort-by-string-attr pastebin--default-user :private)
  722.   (switch-to-buffer (do-list-buffer pastebin--default-user))
  723.   )
  724.  
  725. (defun pastebin-delete-paste-at-point ()
  726.   "Delete the paste at point"
  727.   (interactive)
  728.   (let* ((lexical-binding t)
  729.          (p (pastebin--get-paste-at-point)))
  730.     (when (y-or-n-p (format "Do you really want to delete paste %s from %s\n"
  731.                             (oref p :title)
  732.                             (format-time-string "%c" (seconds-to-time (string-to-number (oref p :date))))))
  733.       (message "%s" (paste-delete (pastebin--get-paste-at-point))))
  734.     (pastebin-list-buffer-refresh)))
  735.  
  736. (defun pastebin-new (p)
  737.   "Create a new paste from buffer"
  738.   (interactive "P")
  739.   (paste-create (buffer-string) p)
  740.   )
  741.  
  742. (defun pastebin-new-from-selection (start end)
  743.   "Create a new paste from buffer selection"
  744.   (interactive "r")
  745.   (paste-create (buffer-substring-no-properties start end))
  746.   )
  747.  
  748. (defun pastebin-create-login (&rest args)
  749.   "Create a login data. The effective login will be done when needed
  750. NOTE: `args' is a keryword list using :username and :dev-key that should
  751. be strings"
  752.   ;; Keyword arguments work arround
  753.   ;; I want to get rid of cl dependence here
  754.   (let* ((lexical-bind t)
  755.          username
  756.          dev-key
  757.          password)
  758.     (while args
  759.       (cond ((eq (car-safe args) :username)
  760.              (setq username (car-safe (cdr-safe args))))
  761.             ((eq (car-safe args) :dev-key)
  762.              (setq dev-key (car-safe (cdr-safe args))))
  763.             ((eq (car-safe args) :password)
  764.              (setq password (car-safe (cdr-safe args))))
  765.             ) ;; (cond ..
  766.       (setq args (cdr-safe args)))
  767.     ;; Function body
  768.     (unless (and username dev-key password)
  769.       (error "pastebin-login argument missing. (dev-key or username or password)"))
  770.     (setq pastebin--default-user (pastebin--paste-user username
  771.                                                        :username username
  772.                                                        :dev-key dev-key
  773.                                                        :password password))
  774.     (message "User %s created, login is on demand. Have a nice day!" username)
  775.     ) ;; (let* ((lexical-bind t)
  776.   ) ;; (defun pastebin-create-login &rest args)
  777.  
  778. ;; Setup minor mode keymap
  779. (or (assq 'pastebin-mode minor-mode-map-alist)
  780.     (setq minor-mode-map-alist (cons (cons 'pastebin-mode pastebin--mode-map)
  781.                                      minor-mode-map-alist)))
  782.  
  783. (provide 'neopastebin)
  784.  
  785. ;;; END of neopastebin
  786.  
  787.  
Advertisement
Add Comment
Please, Sign In to add comment