未臨

Some elisp code snips for pasting in irc channel from inside emacs.

;;; paste in IRC (final version)
(defun url-extra-http-encode-string (str content-type)
  "URL encode STR using CONTENT-TYPE as the coding system."
  (apply 'concat
	 (mapcar (lambda (c)
		   (if (or (and (>= c ?a) (<= c ?z))
			   (and (>= c ?A) (<= c ?Z))
			   (and (>= c ?0) (<= c ?9)))
		       (string c)
		       (format "%%%02x" c)))
		 (encode-coding-string str content-type))))
(defun url-extra-http-encode-string-without-escape (str content-type)
  "Similar to `url-extra-http-encode-string' but treat \"\\\" as regular
character."
  (let ((back-slash (format "%%%02x" ?\\)))
    (replace-regexp-in-string 
     back-slash 
     (concat back-slash back-slash)
     (url-extra-http-encode-string str content-type))))
(defun url-extra-http-post (url data &optional charset)
  "Retrieve URL synchronously with `url-retrieve-synchronously'.
DATA is an alist, e.g., '((field-name . \"value\")).
CHARSET defaults to 'utf-8."
  (or charset (setq charset 'utf-8))
  (let ((url-request-method "POST")
        (url-request-data 
         (mapconcat
          'identity 
          (mapcar (lambda (field)
                    (concat (symbol-name (car field))
                            "="
                            (url-extra-http-encode-string-without-escape
                             (cdr field) charset)))
                  data)
          "&"))
        (url-mime-charset-string (symbol-name charset))
        (url-request-extra-headers 
         `(("Content-Type" . ,(concat
                               "application/x-www-form-urlencoded;charset="
                               (symbol-name charset))))))
    (url-retrieve-synchronously url)))

(setq xwl-paste-username "xwl")
(setq xwl-paste-ubuntu-cn-classes
      '("applescript" "actionscript-french" "ada" "apache" "asm" "asp" "autoit" "bash"
        "blitzbasic" "c" "c_mac" "caddcl" "cadlisp" "cfdg" "cpp" "csharp" "css" "d"
        "delphi" "diff" "div" "dos" "eiffel" "fortran" "freebasic" "gml" "html4strict"
        "inno" "java" "java5" "javascript" "lisp" "lua" "matlab" "mpasm" "mysql" "nsis"
        "objc" "ocaml" "ocaml-brief" "oobas" "oracle8" "pascal" "perl" "php" "php-brief"
        "python" "qbasic" "robots" "ruby" "sas" "scheme" "sdlbasic" "smarty" "sql"
        "tsql" "vb" "vbnet" "vhdl" "visualfoxpro" "xml"))
        (defun xwl-paste-ubuntu-cn (beg end &optional class)
  "Paste region between BEG and END to http://paste.ubuntu.org.cn.
Resulted post url will be appended to your kill ring, so you can
simply yank it when needed."
  (interactive "r")
  (unless class
    (if current-prefix-arg
        (setq class (ido-completing-read "Use mode: " xwl-wgetpaste-ubuntu-cn-classes))
      (setq class "lisp")))
  (let ((url "http://paste.ubuntu.org.cn"))
    (with-current-buffer 
        (url-extra-http-post url
                       `((poster . ,xwl-paste-username)
                         (class . ,class)
                         (paste . "1")
                         (code2 . ,(buffer-substring-no-properties beg end))))
      (goto-char (point-min))
      (if (re-search-forward  
          (concat "<li class=\"highlight\"><a href=\"\/\\([0-9]+\\)\">" xwl-paste-username)
           nil t 1)
          (let ((s (concat url "/" (match-string 1))))
            (kill-new s)
            (message s)
            (kill-buffer (current-buffer)))
        (message "paste failed")
        (switch-to-buffer (current-buffer))))))