Switch branches/tags
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
147 lines (133 sloc) 5.24 KB
;;; bitly.el --- Shorten URLs with from emacs
;; Copyright (C) 2012 Neil Smithline
;; Copyright (C) 2010 Vivek Haldar
;; Current version available at:
;; (or
;; Original version available at
;; (or
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
;; Author: Vivek Haldar <>
;; Created: 27 November 2010
;; Maintainer: Neil Smithline
;;; Commentary:
;; bitly.el allows shortening URLs through the api service. See
;; for info about the api service.
;; Installation:
;; You will need to register with and get an API key. Customize
;; the variables bitly-username and bitly-api-key.
;; Description:
;; Interactive functions:
;; bitly-shorten
;; Shorten an URL (prompted for in the minibuffer) and insert at
;; point.
(require 'url)
(require 'cl))
(defcustom bitly-username nil
"Bitly username."
:type '(choice
(const :tag "none" nil)
(string :tag "bitly_username"))
:group 'bitly)
(defcustom bitly-api-key nil
"Bitly API key."
:type '(choice
(const :tag "none" nil)
(string :tag "bitly_api_key"))
:group 'bitly)
(defcustom bitly-shorten-asynchronously t
"Whether `bitly-shorten' should run asynchronously or not.
Unless you are having probems with `bitly-shorten', there is
probably no need to change this.
If you are calling `bitly-shorten' programmatically, you can set
this to a specific value in a `let' statement."
:type 'boolean
:group 'bitly)
(defconst bitly-api-url "")
(defun bitly-get-me-an-url (prompt)
"Get an URL, prompting the user if needed.."
(let ((the-url)
(when (region-active-p)
(setq the-url (buffer-substring (region-beginning) (region-end))
begin (region-beginning)
end (region-end)))
(unless the-url
(setq the-url (thing-at-point 'url))
(when the-url
(setq begin (beginning-of-thing 'url)
end (end-of-thing 'url))))
(unless the-url
(setq the-url (read-from-minibuffer prompt)
begin (point)
end (point)))
(list the-url begin end)))
(defun bitly-shorten (url &optional begin end)
"Shorten a full URL using Bitly, and insert at point.
Optional BEGIN and END specify a region to get the URL from and
replace it.
Call Bitly asynchronously if `bitly-shorten-asynchronously'."
(interactive (bitly-get-me-an-url "URL to shorten wth Bitly: "))
(assert (and bitly-api-key bitly-username))
(let* ((api-url (concat bitly-api-url
(url-hexify-string url))))
(start-marker (copy-marker (or begin (point-marker))))
(end-marker (copy-marker (or end (point-marker)))))
(if bitly-shorten-asynchronously
(url-retrieve api-url
(list start-marker end-marker))
(let ((buf (url-retrieve-synchronously api-url)))
(with-current-buffer buf
(bitly-process-response nil start-marker end-marker))))))
(defun bitly-process-response (status start-marker end-marker)
"Process the Bitly response in the current buffer, with STATUS and REGION.
The shortened URL will be inserted into REGION, a pair of markers."
(when (eq :error (car status))
(signal (cadr status) (caddr status)))
(let ((short-url (bitly-strip-http-headers (current-buffer))))
(with-current-buffer (marker-buffer start-marker)
;; Save point in an `after' marker per `marker-insertion-type'.
;; If point is in the URL this will move point to the end of the
;; URL. Otherwise, point stays where it is.
(let ((orig-point (copy-marker (point-marker) t)))
(goto-char start-marker)
(delete-region start-marker end-marker)
(insert short-url)
(goto-char orig-point)))))
(defun bitly-strip-http-headers (response-buffer)
"Destructively strip headers from RESPONSE-BUFFER and return the body."
(with-current-buffer response-buffer
(goto-char (point-max))
;; Delete terminating newline
(backward-delete-char 1)
;; Delete header and such.
(beginning-of-line 1)
(delete-region (point-min) (point))
(buffer-substring (point-min) (point-max))))
(provide 'bitly)