From 57366f385a2f1f35bbe741d7542096db81368c72 Mon Sep 17 00:00:00 2001 From: Tom Willemsen Date: Thu, 17 Mar 2011 11:23:07 +0100 Subject: Big changes, last one before I wipe it all. * Added muse * Added graphviz-dot-mode * Remove all trailing whitespace on save. This is the last commit I'm going to do before throwing it all away again. --- emacs.d/elisp/muse/muse-protocols.el | 251 +++++++++++++++++++++++++++++++++++ 1 file changed, 251 insertions(+) create mode 100644 emacs.d/elisp/muse/muse-protocols.el (limited to 'emacs.d/elisp/muse/muse-protocols.el') diff --git a/emacs.d/elisp/muse/muse-protocols.el b/emacs.d/elisp/muse/muse-protocols.el new file mode 100644 index 0000000..5e1061c --- /dev/null +++ b/emacs.d/elisp/muse/muse-protocols.el @@ -0,0 +1,251 @@ +;;; muse-protocols.el --- URL protocols that Muse recognizes + +;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; Author: Brad Collins (brad AT chenla DOT org) + +;; This file is part of Emacs Muse. It is not part of GNU Emacs. + +;; Emacs Muse 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 3, or (at your +;; option) any later version. + +;; Emacs Muse is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with Emacs Muse; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; Here's an example for adding a protocol for the site yubnub, a Web +;; Command line service. +;; +;; (add-to-list 'muse-url-protocols '("yubnub://" muse-browse-url-yubnub +;; muse-resolve-url-yubnub)) +;; +;; (defun muse-resolve-url-yubnub (url) +;; "Resolve a yubnub URL." +;; ;; Remove the yubnub:// +;; (when (string-match "\\`yubnub://\\(.+\\)" url) +;; (match-string 1))) +;; +;; (defun muse-browse-url-yubnub (url) +;; "If this is a yubnub URL-command, jump to it." +;; (setq url (muse-resolve-url-yubnub url)) +;; (browse-url (concat "http://yubnub.org/parser/parse?command=" +;; url))) + +;;; Contributors: + +;; Phillip Lord (Phillip.Lord AT newcastle DOT ac DOT uk) provided a +;; handler for DOI URLs. + +;; Stefan Schlee fixed a bug with handling of colons at the end of +;; URLs. + +;; Valery V. Vorotyntsev contribued the woman:// protocol handler and +;; simplified `muse-browse-url-man'. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Muse URL Protocols +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'info) +(require 'muse-regexps) + +(defvar muse-url-regexp nil + "A regexp used to match URLs within a Muse page. +This is autogenerated from `muse-url-protocols'.") + +(defun muse-update-url-regexp (sym value) + (setq muse-url-regexp + (concat "\\<\\(" (mapconcat 'car value "\\|") "\\)" + "[^][" muse-regexp-blank "\"'()<>^`{}\n]*" + "[^][" muse-regexp-blank "\"'()<>^`{}.,;:\n]+")) + (set sym value)) + +(defcustom muse-url-protocols + '(("[uU][rR][lL]:" muse-browse-url-url identity) + ("info://" muse-browse-url-info nil) + ("man://" muse-browse-url-man nil) + ("woman://" muse-browse-url-woman nil) + ("google://" muse-browse-url-google muse-resolve-url-google) + ("http:/?/?" browse-url identity) + ("https:/?/?" browse-url identity) + ("ftp:/?/?" browse-url identity) + ("gopher://" browse-url identity) + ("telnet://" browse-url identity) + ("wais://" browse-url identity) + ("file://?" browse-url identity) + ("dict:" muse-browse-url-dict muse-resolve-url-dict) + ("doi:" muse-browse-url-doi muse-resolve-url-doi) + ("news:" browse-url identity) + ("snews:" browse-url identity) + ("mailto:" browse-url identity)) + "A list of (PROTOCOL BROWSE-FUN RESOLVE-FUN) used to match URL protocols. +PROTOCOL describes the first part of the URL, including the +\"://\" part. This may be a regexp. + +BROWSE-FUN should accept URL as an argument and open the URL in +the current window. + +RESOLVE-FUN should accept URL as an argument and return the final +URL, or nil if no URL should be included." + :type '(repeat (list :tag "Protocol" + (string :tag "Regexp") + (function :tag "Browse") + (choice (function :tag "Resolve") + (const :tag "Don't resolve" nil)))) + :set 'muse-update-url-regexp + :group 'muse) + +(add-hook 'muse-update-values-hook + (lambda () + (muse-update-url-regexp 'muse-url-protocols muse-url-protocols))) + +(defcustom muse-wikipedia-country "en" + "Indicate the 2-digit country code that we use for Wikipedia +queries." + :type 'string + :options '("de" "en" "es" "fr" "it" "pl" "pt" "ja" "nl" "sv") + :group 'muse) + +(defun muse-protocol-find (proto list) + "Return the first element of LIST whose car matches the regexp PROTO." + (catch 'found + (dolist (item list) + (when (string-match (concat "\\`" (car item)) proto) + (throw 'found item))))) + +;;;###autoload +(defun muse-browse-url (url &optional other-window) + "Handle URL with the function specified in `muse-url-protocols'. +If OTHER-WINDOW is non-nil, open in a different window." + (interactive (list (read-string "URL: ") + current-prefix-arg)) + ;; Strip text properties + (when (fboundp 'set-text-properties) + (set-text-properties 0 (length url) nil url)) + (when other-window + (switch-to-buffer-other-window (current-buffer))) + (when (string-match muse-url-regexp url) + (let* ((proto (match-string 1 url)) + (entry (muse-protocol-find proto muse-url-protocols))) + (when entry + (funcall (cadr entry) url))))) + +(defun muse-resolve-url (url &rest ignored) + "Resolve URL with the function specified in `muse-url-protocols'." + (when (string-match muse-url-regexp url) + (let* ((proto (match-string 1 url)) + (entry (muse-protocol-find proto muse-url-protocols))) + (when entry + (let ((func (car (cddr entry)))) + (if func + (setq url (funcall func url)) + (setq url nil)))))) + url) + +(defun muse-protocol-add (protocol browse-function resolve-function) + "Add PROTOCOL to `muse-url-protocols'. PROTOCOL may be a regexp. + +BROWSE-FUNCTION should be a function that visits a URL in the +current buffer. + +RESOLVE-FUNCTION should be a function that transforms a URL for +publishing or returns nil if not linked." + (add-to-list 'muse-url-protocols + (list protocol browse-function resolve-function)) + (muse-update-url-regexp 'muse-url-protocols + muse-url-protocols)) + +(defun muse-browse-url-url (url) + "Call `muse-protocol-browse-url' to browse URL. +This is used when we are given something like +\"URL:http://example.org/\". + +If you're looking for a good example for how to make a custom URL +handler, look at `muse-browse-url-dict' instead." + (when (string-match "\\`[uU][rR][lL]:\\(.+\\)" url) + (muse-browse-url (match-string 1 url)))) + +(defun muse-resolve-url-dict (url) + "Return the Wikipedia link corresponding with the given URL." + (when (string-match "\\`dict:\\(.+\\)" url) + (concat "http://" muse-wikipedia-country ".wikipedia.org/" + "wiki/Special:Search?search=" (match-string 1 url)))) + +(defun muse-browse-url-dict (url) + "If this is a Wikipedia URL, browse it." + (let ((dict-url (muse-resolve-url-dict url))) + (when dict-url + (browse-url dict-url)))) + +(defun muse-resolve-url-doi (url) + "Return the URL through DOI proxy server." + (when (string-match "\\`doi:\\(.+\\)" url) + (concat "http://dx.doi.org/" + (match-string 1 url)))) + +(defun muse-browse-url-doi (url) + "If this is a DOI URL, browse it. + +DOI's (digitial object identifiers) are a standard identifier +used in the publishing industry." + (let ((doi-url (muse-resolve-url-doi url))) + (when doi-url + (browse-url doi-url)))) + +(defun muse-resolve-url-google (url) + "Return the correct Google search string." + (when (string-match "\\`google:/?/?\\(.+\\)" url) + (concat "http://www.google.com/search?q=" + (match-string 1 url)))) + +(defun muse-browse-url-google (url) + "If this is a Google URL, jump to it." + (let ((google-url (muse-resolve-url-google url))) + (when google-url + (browse-url google-url)))) + +(defun muse-browse-url-info (url) + "If this in an Info URL, jump to it." + (require 'info) + (cond + ((string-match "\\`info://\\([^#\n]+\\)#\\(.+\\)" url) + (Info-find-node (match-string 1 url) + (match-string 2 url))) + ((string-match "\\`info://\\([^#\n]+\\)" url) + (Info-find-node (match-string 1 url) + "Top")) + ((string-match "\\`info://(\\([^)\n]+\\))\\(.+\\)" url) + (Info-find-node (match-string 1 url) (match-string 2 url))) + ((string-match "\\`info://\\(.+\\)" url) + (Info-find-node (match-string 1 url) "Top")))) + +(defun muse-browse-url-man (url) + "If this in a manpage URL, jump to it." + (require 'man) + (when (string-match "\\`man://\\([^(]+\\(([^)]+)\\)?\\)" url) + (man (match-string 1 url)))) + +(defun muse-browse-url-woman (url) + "If this is a WoMan URL, jump to it." + (require 'woman) + (when (string-match "\\`woman://\\(.+\\)" url) + (woman (match-string 1 url)))) + +(provide 'muse-protocols) + +;;; muse-protocols.el ends here -- cgit v1.2.3-54-g00ecf