(require 'cl)
(require 'string-utils nil t)
(autoload 'thing-at-point "thingatpt" "Return the THING at point." nil)
(autoload 'thing-at-point-looking-at "thingatpt" "Return non-nil if point is in or just after a match for REGEXP." nil)
(autoload 'thing-at-point-url-at-point "thingatpt" "Return the URL around or before point." nil)
(autoload 'url-generic-parse-url "url-parse" "Return an URL-struct of the parts of URL." nil)
(autoload 'url-normalize-url "url-util" "Return a 'normalized' version of URL." nil)
(autoload 'url-hexify-string "url-util" "Return a new string that is STRING URI-encoded." nil)
(autoload 'browse-url "browse-url" "Ask a WWW browser to load a URL." t)
(declare-function string-utils-has-darkspace-p "string-utils.el")
(eval-when-compile
(defvar thing-at-point-short-url-regexp))
(defconst browse-url-dwim-google-fragment "http://www.google.com/search?ie=utf-8&oe=utf-8&q="
"URL fragment which can be used to construct a Google search.")
(defgroup browse-url-dwim nil
"Context-sensitive external browse URL or Internet search."
:version "0.6.8"
:link '(emacs-commentary-link :tag "Commentary" "browse-url-dwim")
:link '(url-link :tag "GitHub" "http://github.com/rolandwalker/browse-url-dwim")
:link '(url-link :tag "EmacsWiki" "http://emacswiki.org/emacs/BrowseUrlDwim")
:prefix "browse-url-dwim-"
:group 'external
:group 'browse-url
:group 'hypermedia
:group 'convenience)
(defcustom browse-url-dwim-less-feedback nil
"Give less echo area feedback."
:type 'boolean
:group 'browse-url-dwim)
(defcustom browse-url-dwim-max-prompt-length 40
"The maximum length for a default URL when prompted."
:type 'integer
:group 'browse-url-dwim)
(defcustom browse-url-dwim-always-confirm-extraction t
"Always prompt for confirmation of URLs detected from context."
:type 'boolean
:group 'browse-url-dwim)
(defcustom browse-url-dwim-permitted-tlds '(
"com"
"edu"
"gov"
"mil"
"net"
"org"
)
"Top-level domains used when trying to recognize URLs in text.
This is purposefully set to a minimal list by default to keep
`thing-at-point' from over-guessing when trying to extract a URL
from context. Other top-level domains are also recognized in
fully-qualified URLs which include a scheme (eg \"http\")."
:type '(repeat string)
:group 'browse-url-dwim)
(defcustom browse-url-dwim-permitted-schemes '(
"http"
"https"
"ftp"
)
"URI schemes recognized by `browse-url-dwim'.
This is purposefully set to a minimal list by default to keep
`thing-at-point' from over-guessing. Other schemes are not
recognized when extracting a URL from context.
For URLs given at interactive prompts, this limit does not
apply."
:type '(repeat string)
:group 'browse-url-dwim)
(defcustom browse-url-dwim-install-aliases t
"Whether to install command aliases for `browse-url-dwim'.
When this option is set and `browse-url-dwim-mode' is turned
on, `browse' is aliased to `browse-url-dwim' and `google' is
aliased to `browse-url-dwim-guess'."
:type 'boolean
:group 'browse-url-dwim)
(defcustom browse-url-dwim-search-url browse-url-dwim-google-fragment
"URL fragment used to construct Internet searches.
The default string uses Google."
:type 'string
:group 'browse-url-dwim)
(defgroup browse-url-dwim-keys nil
"Key bindings for `browse-url-dwim-mode'."
:group 'browse-url-dwim)
(defcustom browse-url-dwim-keystrokes '("C-c b")
"Key sequences to activate an external web browser.
These key sequences will invoke `browse-url-dwim' when
`browse-url-dwim-mode' is active.
The format for key sequences is as defined by `kbd'."
:type '(repeat string)
:group 'browse-url-dwim-keys)
(defcustom browse-url-dwim-guess-keystrokes '("C-c g")
"Key sequences to activate an Internet search in an external browser.
These key sequences will invoke `browse-url-dwim-guess' when
`browse-url-dwim-mode' is active.
The format for key sequences is as defined by `kbd'."
:type '(repeat string)
:group 'browse-url-dwim-keys)
(defcustom browse-url-dwim-search-keystrokes nil
"Key sequences to activate an Internet search in an external browser.
These key sequences will invoke `browse-url-dwim-search' when
`browse-url-dwim-mode' is active.
The format for key sequences is as defined by `kbd'."
:type '(repeat string)
:group 'browse-url-dwim-keys)
(defvar browse-url-dwim-mode nil
"Mode variable for `browse-url-dwim-mode'.")
(defvar browse-url-history-list nil
"A list of strings entered at `browse-url' prompts.")
(defvar browse-url-dwim-host-mandatary-schemes
'(
"acap"
"afs"
"crid"
"dict"
"fish"
"ftp"
"git"
"gopher"
"h323"
"http"
"https"
"iax"
"icap"
"imap"
"ipp"
"irc"
"irc6"
"ircs"
"mms"
"mmsh"
"msrp"
"mtqp"
"mumble"
"mvn"
"nfs"
"nntp"
"pop"
"rmi"
"rsync"
"rtmp"
"rtsp"
"rtspu"
"service" "sftp"
"sgn"
"sieve"
"snmp"
"ssh"
"teamspeak"
"telnet"
"tftp"
"tip"
"tn3270"
"vemmi"
"webcal"
"xmpp"
"xri"
"z39.50r"
"z39.50s"
)
"URI schemes for which a host portion is mandatory.")
(defvar browse-url-dwim-prompt-list '(
("google\\." . "Google: ")
("yahoo\\." . "Yahoo: ")
("bing\\." . "Bing: ")
)
"Alist describing interactive prompts.
The car of each cell is a regexp which matches into the URL
fragment for creating a search. The cdr of each cell is the
associated prompt.")
(defvar browse-url-dwim-mode-map (make-sparse-keymap)
"Keymap for `browse-url-dwim-mode' minor-mode.")
(dolist (cmd '(browse-url-dwim browse-url-dwim-guess browse-url-dwim-search))
(dolist (k (symbol-value (intern (concat (symbol-name cmd) "-keystrokes"))))
(define-key browse-url-dwim-mode-map (read-kbd-macro k) cmd)))
(defmacro browse-url-dwim-called-interactively-p (&optional kind)
"A backward-compatible version of `called-interactively-p'.
Optional KIND is as documented at `called-interactively-p'
in GNU Emacs 24.1 or higher."
(cond
((not (fboundp 'called-interactively-p))
'(interactive-p))
((condition-case nil
(progn (called-interactively-p 'any) t)
(error nil))
`(called-interactively-p ,kind))
(t
'(called-interactively-p))))
(unless (fboundp 'use-region-p)
(unless (boundp 'use-empty-active-region)
(defvar use-empty-active-region nil
"Whether \"region-aware\" commands should act on empty regions."))
(defun use-region-p ()
"Return t if the region is active and it is appropriate to act on it."
(and (region-active-p)
(or use-empty-active-region (> (region-end) (region-beginning))))))
(unless (fboundp 'region-active-p)
(defun region-active-p ()
"Return t if Transient Mark mode is enabled and the mark is active."
(and transient-mark-mode mark-active)))
(unless (fboundp 'string-match-p)
(defun string-match-p (regexp string &optional start)
"Same as `string-match' except this function does not change the match data."
(let ((inhibit-changing-match-data t))
(string-match regexp string start))))
(unless (fboundp 'string-utils-has-darkspace-p)
(defun string-utils-has-darkspace-p (obj)
"Test whether OBJ, when coerced to a string, has any non-whitespace characters.
Returns the position of the first non-whitespace character
on success."
(let ((str-val (if (stringp obj) obj (format "%s" obj))))
(string-match-p "[^ \t\n\r\f]" str-val))))
(defun browse-url-dwim-coerce-to-web-url (url &optional any-scheme add-scheme)
"Coerce URL to a string representing a valid web address.
Returns nil on failure.
If ANY-SCHEME is set, no restriction is placed on permitted
schemes in the URL. Otherwise, `browse-url-dwim-permitted-schemes'
is consulted.
The scheme \"http://\" will be prepended in the absence of a
scheme. The default scheme can be changed by passing ADD-SCHEME.
Note that ADD-SCHEME is a string which must include any required
colon and slash characters.
The value of `browse-url-dwim-permitted-tlds' is consulted when
determining whether to add a scheme."
(unless (stringp add-scheme)
(setq add-scheme "http://"))
(unless (stringp url)
(setq url (if url (format "%s" url) "")))
(callf substring-no-properties url)
(let ((parsed nil)
(struct-offset))
(setq url
(catch 'url
(when (not (string-utils-has-darkspace-p url))
(throw 'url nil))
(setq parsed (url-generic-parse-url url))
(setq struct-offset (if (symbolp (aref parsed 0)) 1 0))
(when (and (not (aref parsed (+ 0 struct-offset)))
(string-match-p (concat "\\`[^/]+\\." "\\(?:" (regexp-opt browse-url-dwim-permitted-tlds) "\\)" "\\(/\\|\\'\\)") url))
(callf2 concat add-scheme url)
(setq parsed (url-generic-parse-url url))
(setq struct-offset (if (symbolp (aref parsed 0)) 1 0)))
(when (and (not any-scheme)
(not (member (aref parsed (+ 0 struct-offset)) browse-url-dwim-permitted-schemes)))
(throw 'url nil))
(when (and (member (aref parsed (+ 0 struct-offset)) browse-url-dwim-host-mandatary-schemes)
(or (not (aref parsed (+ 3 struct-offset)))
(not (string-match-p "\\." (aref parsed (+ 3 struct-offset))))))
(throw 'url nil))
(throw 'url url))))
(when url
(url-normalize-url url)))
(defun browse-url-dwim-add-prompt-default (prompt-string default-string &optional length-limit)
"Using PROMPT-STRING as a base, insert DEFAULT-STRING.
The revised string is returned.
Optional LENGTH-LIMIT limits the length of the inserted default.
Defaults to the value of `browse-url-dwim-max-prompt-length' when
not specified.
PROMPT-STRING is expected to end with \": \", which will be added if
not present.
DEFAULT-STRING may be nil, in which case no default is inserted."
(setq length-limit (min (or length-limit browse-url-dwim-max-prompt-length) (length default-string)))
(save-match-data
(if (not default-string)
(replace-regexp-in-string "[: ]*\\'" ": " prompt-string)
(callf substring default-string 0 length-limit)
(replace-regexp-in-string "[: ]*\\'" (concat " (" default-string "): ") prompt-string))))
(defun browse-url-dwim-context-url ()
"Find a Web URL at the point or in the region.
If there is an active region which looks like a URL, returns
that.
If `thing-at-point' finds a URL at the point, returns that.
However, note that `thing-at-point' here does not follow default
behavior, and is constrained narrowly to defined Web protocols
and popular top-level domains.
If no prospective URL is found, returns nil."
(require 'thingatpt nil t)
(let ((thing-at-point-short-url-regexp (concat (if (boundp 'thing-at-point-short-url-regexp)
thing-at-point-short-url-regexp
"[-A-Za-z0-9]+\\.[-A-Za-z0-9.]+[^]\t\n \"'<>[^`{}]*[^]\t\n \"'<>[^`{}.,;]+")
"?\\."
"\\(?:" (regexp-opt browse-url-dwim-permitted-tlds) "\\)"
"\\(?:/[^ \t\r\f\n]+\\)?"))
(case-fold-search t))
(or
(and (use-region-p)
(browse-url-dwim-coerce-to-web-url (buffer-substring-no-properties (region-beginning) (region-end))))
(browse-url-dwim-coerce-to-web-url (ignore-errors (thing-at-point 'url)))
(and (ignore-errors (thing-at-point-looking-at thing-at-point-short-url-regexp))
(browse-url-dwim-coerce-to-web-url (buffer-substring-no-properties (match-beginning 0) (match-end 0))))
(browse-url-dwim-coerce-to-web-url (ignore-errors (thing-at-point-url-at-point 'lax))))))
(defun browse-url-dwim-get-url (&optional always-prompt prompt-string fallback-default)
"Find a Web URL by context or user input.
First, attempt to find a Web URL by calling
`browse-url-dwim-context-url'.
If that fails, prompt the user. User input is returned
without testing for validity.
If optional ALWAYS-PROMPT is set, always prompt the user, filling
in a default value from context if possible. Otherwise, the
value of `browse-url-dwim-always-confirm-extraction' determines
prompting behavior.
PROMPT-STRING (if supplied) gives a string to use at the prompt.
FALLBACK-DEFAULT (if supplied) is used as an interactive default if
a candidate is not found by other means."
(callf or always-prompt browse-url-dwim-always-confirm-extraction)
(callf or prompt-string "Browse to page: ")
(let ((extracted-text (browse-url-dwim-context-url))
(entered-text ""))
(when (or always-prompt
(not extracted-text))
(callf or extracted-text fallback-default)
(callf browse-url-dwim-add-prompt-default prompt-string extracted-text)
(setq entered-text (replace-regexp-in-string "[\t\r\n\f]+" " "
(read-from-minibuffer prompt-string nil nil nil 'browse-url-history-list))))
(if (string-utils-has-darkspace-p entered-text)
entered-text
extracted-text)))
(defun browse-url-dwim-make-search-prompt (search-url)
"Given SEARCH-URL, return a prompt string.
The prompt string is based on `browse-url-dwim-prompt-list'."
(let ((prompt (catch 'match
(dolist (cell browse-url-dwim-prompt-list)
(when (and (stringp search-url)
(string-match-p (car cell) search-url))
(throw 'match (cdr cell)))))))
(or prompt "Internet Search: ")))
(defun browse-url-dwim-find-search-text (&optional search-url guess)
"Find some text on which to conduct a search.
Finds a URL or search string from the region, or text near the
point, or from an interactive prompt.
SEARCH-URL defaults to `browse-url-dwim-search-url'.
If GUESS is non-nil, assume a URL extracted from text is good
and skip an interactive prompt."
(callf or search-url browse-url-dwim-search-url)
(let* ((region (when (use-region-p) (buffer-substring-no-properties (region-beginning) (region-end))))
(region-url (browse-url-dwim-coerce-to-web-url region))
(prompt-string (browse-url-dwim-make-search-prompt search-url))
(entered-text "")
(text (or region-url region)))
(when (stringp text)
(callf substring-no-properties text))
(when (or (null text)
browse-url-dwim-always-confirm-extraction)
(callf or text (thing-at-point 'symbol))
(callf browse-url-dwim-add-prompt-default prompt-string text)
(setq entered-text
(if guess
(browse-url-dwim-get-url nil (browse-url-dwim-make-search-prompt search-url) text)
(read-from-minibuffer prompt-string nil nil nil 'browse-url-history-list))))
(when (string-utils-has-darkspace-p entered-text)
(setq text entered-text))
(when (stringp text)
(setq text (replace-regexp-in-string "[\t\r\n\f]+" " " text)))
text))
(define-minor-mode browse-url-dwim-mode
"Turn on `browse-url-dwim-mode'.
Turning on `browse-url-dwim' will activate keybindings as defined
in `customize'. It may also install a command alias for `browse'
and `google' as controlled by `browse-url-dwim-install-aliases'.
When called interactively with no prefix argument this command
toggles the mode. With a prefix argument, it enables the mode
if the argument is positive and otherwise disables the mode.
When called from Lisp, this command enables the mode if the
argument is omitted or nil, and toggles the mode if the argument
is 'toggle."
:group 'browse-url-dwim
:global t
(cond
(browse-url-dwim-mode
(when browse-url-dwim-install-aliases
(unless (and (fboundp 'browse)
(eq (symbol-function 'browse) 'osx-browse-url))
(defalias 'browse 'browse-url-dwim))
(unless (and (fboundp 'google)
(eq (symbol-function 'google) 'osx-browse-guess))
(defalias 'google 'browse-url-dwim-guess)))
(when (and (browse-url-dwim-called-interactively-p 'interactive)
(not browse-url-dwim-less-feedback))
(message "browse-url-dwim mode enabled")))
(t
(when browse-url-dwim-install-aliases
(when (and (fboundp 'browse)
(eq (symbol-function 'browse) 'browse-url-dwim))
(fmakunbound 'browse))
(when (and (fboundp 'google)
(eq (symbol-function 'google) 'browse-url-dwim-guess))
(fmakunbound 'google)))
(when (and (browse-url-dwim-called-interactively-p 'interactive)
(not browse-url-dwim-less-feedback))
(message "browse-url-dwim mode disabled")))))
(defun browse-url-dwim (url)
"Opens a URL in an external browser.
When called interactively, `browse-url-dwim-get-url' will be
used to find an appropriate URL.
The browser used is as configured for `browse-url'."
(interactive
(list
(browse-url-dwim-coerce-to-web-url (browse-url-dwim-get-url) t)))
(browse-url url))
(defun browse-url-dwim-search (&optional text search-url guess)
"Perform an Internet search for TEXT, or region, or interactive input.
If TEXT is a URL, browse to page directly. Otherwise
invoke an Internet search using TEXT. When called interactively,
TEXT may be taken from the region or entered at a prompt.
Optional SEARCH-URL specifies the URL fragment used to construct
the search request. If not specified, the customizable variable
`browse-url-dwim-search-url' is used.
If GUESS is non-nil, an attempt will be made to extract a URL
from the context around the point. If successful, this command
is equivalent to `browse-url-dwim'."
(interactive)
(callf or search-url browse-url-dwim-search-url)
(unless text
(setq text (browse-url-dwim-find-search-text search-url guess)))
(cond
((not (string-utils-has-darkspace-p text))
(error "No valid query or URL"))
((browse-url-dwim-coerce-to-web-url text)
(browse-url-dwim (browse-url-dwim-coerce-to-web-url text)))
(t
(browse-url-dwim (concat search-url (url-hexify-string text))))))
(defun browse-url-dwim-guess (&optional text search-url)
"Perform Internet search or browse to URL under point, according to context.
Identical to calling `browse-url-dwim-search' with GUESS set
to non-nil.
Optional TEXT is a string to be submitted to the search
engine.
Optional SEARCH-URL overrides the default search engine
URL."
(interactive)
(browse-url-dwim-search text search-url 'guess))
(provide 'browse-url-dwim)