Archive

前回(emacs-w3m上で短縮URLを取得する – その1)で紹介したemacs-w3m内で短縮URLを取得する関数ですがちょっと整理して、TinyURL、bit.ly、ig.gdなど複数のサービスに対応するようにしてみました。

前回のサービス毎の関数を一つにまとめています。

;; サービスを使用して短縮URLをkill-ringに入れる関数
;; 引数 url     ... URL
;; 引数 service ... 使用するサービス -> 'TinyURL or 'is.gd or 'bit.ly
(defun shorten-url-to-kill-ring (url &optional service)
  (let (service-uri
        key
        get-regexp
        method)
    ;; default service to shorten
    (unless service (setq service 'TinyURL))
    ;; switch parameter by each url-shorten service
    (cond ((eq service 'TinyURL)
           ;; via http://tinyurl.com/  use API
           (setq service-uri "http://tinyurl.com/api-create.php")
           (setq key "url")
           (setq method "POST")
           (setq get-regexp "\\(http://tinyurl.com/.+\\)"))
          ((eq service 'is.gd)
           ;; via http://is.gd/  use API
           (setq service-uri "http://is.gd/api.php")
           (setq key "longurl")
           (setq method "GET")
           (setq get-regexp "\\(http://is.gd/.+\\)"))
          ((eq service 'bit.ly)
           ;; via http://bit.ly/  NOT USE API, get from web page
           (setq service-uri "http://bit.ly")
           (setq method "POST")
           (setq key "url")
           (setq get-regexp "id *= *\"shortened-url\" +value *= *\"\\(http://bit.ly/.+\\)\" +/>")))
    ;; use url package ...
    (setq url-request-method method)
    (if (equal method "POST")
        (setq url-request-data (concat key "=" (url-hexify-string url)))
      (setq url-request-data nil)
      (setq service-uri (concat service-uri "?" key "=" (url-hexify-string url))))
    ;; Now, try to fetch short URL
    (url-retrieve service-uri
                  '(lambda (status cbargs)
                     (point-min)
                     (if (re-search-forward (car (cdr cbargs)) nil t)
                         (progn
                           (setq result-url (match-string-no-properties 1))
                           (kill-new result-url nil)
                           (message "Copy '%s' to ring, shorten %s" result-url (car cbargs))))
                     (kill-buffer (current-buffer)))
                  (list (list url get-regexp)))))




;; 上をw3m上から使用するための関数 (この例ではis.gdを使用する)
(defun my-w3m-shorten-url ()
  (interactive)
  (shorten-url-to-kill-ring
     (or (w3m-url-valid (w3m-anchor))
         (w3m-url-valid w3m-current-url))
     'is.gd))

キーバインドとかは必要だったら適当にしてください。

(eval-after-load "w3m"
  '(progn
     ;; w3m-mode-map key binds
     (define-key w3m-mode-map "\C-cs" 'my-w3m-shorten-url)))