diff options
author | Tom Willemsen | 2011-03-17 11:36:56 +0100 |
---|---|---|
committer | Tom Willemsen | 2011-03-17 11:37:07 +0100 |
commit | 82b8ca280905ea284730f228ae082c42c348e818 (patch) | |
tree | 0c60d42c717905632c32ad80d83397d59c7d5036 /emacs.d/elisp/muse/muse-protocols.el | |
parent | 04b349e8e00c2720fed4b14b7a1e0616db27ad2f (diff) | |
download | dotfiles-82b8ca280905ea284730f228ae082c42c348e818.tar.gz dotfiles-82b8ca280905ea284730f228ae082c42c348e818.zip |
Big emacs cleanup, must be lighter
Diffstat (limited to 'emacs.d/elisp/muse/muse-protocols.el')
-rw-r--r-- | emacs.d/elisp/muse/muse-protocols.el | 251 |
1 files changed, 0 insertions, 251 deletions
diff --git a/emacs.d/elisp/muse/muse-protocols.el b/emacs.d/elisp/muse/muse-protocols.el deleted file mode 100644 index 5e1061c..0000000 --- a/emacs.d/elisp/muse/muse-protocols.el +++ /dev/null @@ -1,251 +0,0 @@ -;;; 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 |