smallurl.el

   1 ;;; smallurl.el --- Tinify URLs
   2
   3 ;; Copyright (C) 2009 Philip Jackson
   4
   5 ;; Author: Philip Jackson <phil@shellarchive.co.uk>
   6 ;; Version: 0.2
   7
   8 ;; This file is not currently part of GNU Emacs.
   9
  10 ;; This program is free software; you can redistribute it and/or
  11 ;; modify it under the terms of the GNU General Public License as
  12 ;; published by the Free Software Foundation; either version 2, or (at
  13 ;; your option) any later version.
  14 ;;
  15 ;; This program is distributed in the hope that it will be useful, but
  16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19 ;;
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this program ; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Installation:
  26 ;;
  27 ;; To install put smallurl.el in your load-path and
  28 ;; (require 'smallurl) in your initialisation file.
  29
  30 ;;; Usage:
  31 ;;
  32 ;; There are two interactive functions... with which you might want to
  33 ;; interact:
  34 ;;
  35 ;; smallurl-replace-at-point - replace the url at point with a tiny one.
  36 ;; smallurl                  - print and put into the kill ring the tiny
  37 ;;                             version of the url prompted for.
  38 ;;
  39 ;; Setting `smallurl-service' will let you choose a service.
  40
  41 ;;; Inspired by, and code stolen from:
  42 ;;
  43 ;; http://www.emacswiki.org/emacs/TinyUrl
  44
  45 (require 'mm-url)
  46
  47 (defvar smallurl-service 'tinyurl
  48   "The service to use. One of 'tinyurl or 'trim.")
  49
  50 (defvar smallurl-services-map
  51   '((tinyurl . "http://tinyurl.com/api-create.php?url=")
  52     (trim    . "http://api.tr.im/api/trim_simple?url=")
  53     (untiny  . "http://untiny.me/api/1.0/extract?format=text&url="))
  54   "Alist of tinyfy services.")
  55
  56 (defun smallurl-get (longurl)
  57   "Tinyfy LONGURL."
  58   (let ((api (cdr (assoc smallurl-service smallurl-services-map))))
  59     (unless api
  60       (error (concat
  61               "Invalid service try one of "
  62               (mapconcat (lambda (x)
  63                            (symbol-name (car x)))
  64                          smallurl-services-map ", "))))
  65     (with-temp-buffer
  66       (mm-url-insert
  67        (concat api longurl))
  68       (buffer-substring (point-min) (point-at-eol)))))
  69
  70 ;;;###autoload
  71 (defun smallurl-replace-at-point ()
  72   "Replace the url at point with a tiny version."
  73   (interactive)
  74   (let* ((url-bounds (bounds-of-thing-at-point 'url))
  75          (url (thing-at-point 'url))
  76          (newurl (smallurl-get url)))
  77     (save-restriction
  78       (narrow-to-region (car url-bounds) (cdr url-bounds))
  79        (delete-region (point-min) (point-max))
  80       (insert newurl))
  81     newurl))
  82
  83 ;;;###autoload
  84 (defun smallurl ()
  85   "Print a tiny version of the url given at prompt. By defualt
  86 will ask you for the url at point, if any."
  87   (interactive)
  88   (let ((url (thing-at-point 'url))
  89         (enable-recursive-minibuffers t)
  90         (val))
  91     (setq val (read-from-minibuffer
  92                (concat "Url"
  93                        (when url
  94                          (concat " (" url ")"))
  95                        ": ")))
  96     (let ((url (smallurl-get
  97                 (cond
  98                   ((and (equal val "") url)
  99                    url)
 100                   ((> (length val) 0)
 101                    val)
 102                   (t
 103                    (error "No word to lookup"))))))
 104       (kill-new (message url)))))
 105
 106 (provide 'smallurl)