Warning: this is an htmlized version!
The original is here, and
the conversion rules are here.
;;; eev-bowse-url.el - eev functions that operate on the url at point.

;; Copyright (C) 2006,2007,2008,2009,2012 Free Software Foundation, Inc.
;;
;; This file is part of GNU eev.
;;
;; GNU eev 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, or (at your option)
;; any later version.
;;
;; GNU eev 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 GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;
;; Author:     Eduardo Ochs <eduardoochs@gmail.com>
;; Maintainer: Eduardo Ochs <eduardoochs@gmail.com>
;; Version:    2012feb27
;; Keywords:   e-scripts, hyperlinks, hypertext
;;
;; Latest version: <http://angg.twu.net/eev-current/eev-bowser-url.el>
;;       htmlized: <http://angg.twu.net/eev-current/eev-bowser-url.el.html>

;;; Commentary:

;; Here's a quick explanation of what the functions in this file do.
;; Suppose that you've downloaded local copies of two URLs:
;;
;;        http://foo.bar/plic.txt
;;   and  http://foo.bar/ploc/bletch.ps
;;
;; using "psne" (for an alternative, see `brep', below); if the
;; environment variable $S is set to the default, that is, S=~/snarf,
;; then the local copies will be at
;;
;;        ~/snarf/http/foo.bar/plic.txt
;;   and  ~/snarf/http/foo.bar/ploc/bletch.ps ;
;;
;; then if you place the point over "http://foo.bar/plic.txt" and type
;; `M-x brfl' you will visit the local copy of "plic.txt" in a buffer,
;; with `find-fline'; if you place the point over
;; "http://foo.bar/ploc/bletch.ps" and type `M-x brgvl' you will open
;; the local copy of "bletch.ps" with gv, with `find-pspage'; and if
;; you place the point over any one of these urls and type `M-x brep'
;; then you'll get a temporary buffer like this:
;;   ______________________________________________________________ 
;;  |# (find-psne-links "http://foo.bar/ploc/bletch.ps")           |
;;  |# http://foo.bar/ploc/bletch.ps                               |
;;  |                                                              |
;;  |* (eepitch-shell)                                             |
;;  |mkdir -p $S/http/foo.bar/ploc/                                |
;;  |cd       $S/http/foo.bar/ploc/                                |
;;  |wget      http://foo.bar/ploc/bletch.ps                       |
;;  |echo     'http://foo.bar/ploc/bletch.ps' >> ~/.psne.log       |
;;  |                                                              |
;;  |                                                              |
;;  |--:**-  *Elisp hyperlinks*   All L1    (Fundamental)----------|
;;  |______________________________________________________________|
;;
;; that you can use to download a local copy even if you have not
;; installed the rcfile patches with eev-rctool to have a "psne"
;; command function available in the shell.
;;
;; See <http://angg.twu.net/eev-article.html#local-copies>.
;;
;; Notes:
;; A log of the local copies is stored at: (find-fline ".psne.log")
;; and these local copies can be "visited" with brfl, brgvl, brml,
;; brwl, etc.
;; 2007apr01: offby1 pointed this to me:
;;   (find-efunction 'browse-url-of-dired-file)
;;   (find-efunction 'browse-url-of-file)

;; «.conversion-functions»	(to "conversion-functions")
;; «.eeurl-define-from»		(to "eeurl-define-from")
;; «.many-br-functions»		(to "many-br-functions")

;; New stuff, 2007dec21:
;; «.find-wget»			(to "find-wget")
;; «.brwget»			(to "brwget")
;; «.ee-cp»			(to "ee-cp")
;; «.find-psne-links»		(to "find-psne-links")
;; «.brep»			(to "brep")


;; Autoloads:
;; (find-efile "net/browse-url.el")
;; (find-efile "net/browse-url.el" "defun browse-url-interactive-arg")
;;
(autoload 'browse-url-interactive-arg "browse-url")



;;
;; Utility functions.
;;

(defun eeurl-dired-file-name-at-point ()
  (if (eq major-mode 'dired-mode)
      (file-name-sans-versions (dired-get-filename) t)
    (error "Not in dired mode")))


;; «conversion-functions»  (to ".conversion-functions")
;;
(defun eeurl-u-to-f (url)
  "Convert an url like http://foo/bar to a filename like $S/http/foo/bar."
  ;; Add comments about psne and the snarf directory
  (replace-regexp-in-string "^\\(https?\\|ftp\\)://" "$S/\\1/" url))

(defun eeurl-f-to-u (fname)
  "Convert a filename to a \"file://\" url"
  (concat "file://" (expand-file-name (ee-expand fname))))

(defun eeurl-u-to-u-l (url)
  "Convert a url like http://foo/bar to a url like file://<$S>/http/foo/bar.
This should be made smarter - file:// urls should be returned unchanged."
  ;; Add comments about psne and the snarf directory
  (eeurl-f-to-u (eeurl-u-to-f url)))


;; The functions that generate the defuns.
;; Here is the explanation for the cryptic names that they use.
;; Names, long form:
;;              dired-    Names, short form:
;;   url-at-   fname-at-
;;    point      point        up     dfp
;;      |          |          |       |
;;      v          v          v       v
;;     url <===> fname        u <===> f
;;        \      /             \     /
;;         v    v               v   v
;;         action                 a
;;
;; Also, an "l" suffix means "prefer local copy" when both local and
;; remote make sense.
;;
;; Example: `eeurl-utoa-to-uptoa-defun' takes the name of a u->a
;; function (a symbol) and produces the defun for a up->a function
;; that is a wrapper around the original function.
;;
;; u  - string: an url, like http://foo/bar
;; sf - string: a snarfed filename, like $S/http/foo/bar
;; f  - string: a filename, like /tmp/foo
;; fu - string: a "file://" url, like file:///tmp/foo
;; su - string: a snarfed file url, like file:///home/edrx/snarf/http/foo/bar
;; _fun - symbol; a function whose argument is a _
;; brfun - symbol: a browse-url-like function
;; def___ - a defun sexp

(defun eeurl-utoa-to-uptoa-defun (find-uxxx brxxx)
  "Try this: (find-epp (eeurl-utoa-to-uptoa-defun 'find-w3m 'brw))"
  `(defun ,brxxx (url &rest ignore)
     ,(format "Apply `%S' on URL." find-uxxx)
     (interactive (browse-url-interactive-arg "URL: "))
     (setq browse-url-browser-function ',brxxx)
     (list ',find-uxxx url '-> (,find-uxxx url))))

(defun eeurl-utoa-to-uptoal-defun (find-uxxx brxxxl)
  "Try this: (find-epp (eeurl-utoa-to-uptoal-defun 'find-w3m 'brwl))"
  `(defun ,brxxxl (url &rest ignore)
     ,(format "Apply `%S' on the local url associated to URL." find-uxxx)
     (interactive (browse-url-interactive-arg "URL: "))
     (setq browse-url-browser-function ',brxxxl)
     (setq url (eeurl-u-to-u-l url))
     (list ',find-uxxx url '-> (,find-uxxx url))))

(defun eeurl-ftoa-to-uptoa-defun (find-xxx brxxxl)
  "Try this: (find-epp (eeurl-ftoa-to-uptoa-defun 'find-fline 'brfl))"
  `(defun ,brxxxl (url &rest ignore)
     ,(format "Apply `%S' on the local file name associated to URL." find-xxx)
     (interactive (browse-url-interactive-arg "URL: "))
     (setq browse-url-browser-function ',brxxxl)
     (let ((fname (eeurl-u-to-f url)))
       (list ',find-xxx fname '-> (,find-xxx fname)))))

(defun eeurl-ftoa-to-dfptoa-defun (find-xxx brxxxd)
  "Try this: (find-epp (eeurl-ftoa-to-dfptoa-defun 'find-pspage 'brgvd))"
  `(defun ,brxxxd ()
     ,(format "Apply `%S' on the dired file at point." find-xxx)
     (interactive)
      (let ((fname (eeurl-dired-file-name-at-point)))
	(message (format "%S" (list ',find-xxx fname '->
				    (,find-xxx fname)))))))

(defun eeurl-utoa-to-dfptoa-defun (find-uxxx brxxxd)
  "Try this: (find-epp (eeurl-utoa-to-dfptoa-defun 'find-w3m 'brwd))"
  ;; Note: a command like brgvd is in the right format to be bound in
  ;; dired-mode-map... See, for example: (find-efunction 'dired-find-file)
  `(defun ,brxxxd ()
     ,(format "Apply `%S' on the url of the dired file at point." find-uxxx)
     (interactive)
      (let ((url (eeurl-f-to-u
		  (eeurl-dired-file-name-at-point))))
	(message (format "%S" (list ',find-uxxx url '->
				    (,find-uxxx url)))))))


;;
;; The high-level interface - eeurl-define-from
;;

;; «eeurl-define-from»  (to ".eeurl-define-from")

(defun eeurl-keywords-to-builder (keyword1 keyword2)
  (let ((ks (list keyword1 keyword2)))
    (cond ((equal ks '(:url->action:  :remote:)) 'eeurl-utoa-to-uptoa-defun)
	  ((equal ks '(:url->action:   :local:)) 'eeurl-utoa-to-uptoal-defun)
	  ((equal ks '(:url->action:   :dired:)) 'eeurl-utoa-to-dfptoa-defun)
	  ((equal ks '(:fname->action: :local:)) 'eeurl-ftoa-to-uptoa-defun)
	  ((equal ks '(:fname->action: :dired:)) 'eeurl-ftoa-to-dfptoa-defun))))

(defun eeurl-builders-for-define-from
  (keyword1 origfun keyword2 newfun &rest rest)
  "Internal use - see: (find-efunctiondescr 'eeurl-define-from)"
  (cons `(,(eeurl-keywords-to-builder keyword1 keyword2)
	  ',origfun ',newfun)
	(if rest (apply 'eeurl-builders-for-define-from
			keyword1 origfun rest))))

(defun eeurl-defuns-for-define-from (&rest rest)
  "Internal use - see: (find-efunctiondescr 'eeurl-define-from)"
  (mapcar 'eval (apply 'eeurl-builders-for-define-from rest)))

;; This is pretty nice...
(defun find-eeurl-define-from (&rest rest)
  "Show the code that a `eeurl-define-from' call would evaluate, without evaluating it."
  (find-epp (cons 'progn (apply 'eeurl-defuns-for-define-from rest))))

(defun eeurl-define-from (&rest rest)
  "Define a series of browse-url or dired-visit functions from a standard function.
This is hard to describe abstractly, so try the `find-epp' sexps
below - they just produce lists and display them, and have no
side-effects.

  (find-epp (eeurl-builders-for-define-from
	     :fname->action: 'find-pspage
	     :local:         'brgvl
	     :dired:         'brgvd))

  (find-epp (eeurl-defuns-for-define-from
	     :fname->action: 'find-pspage
	     :local:         'brgvl
	     :dired:         'brgvd))

`eeurl-define-from' runs the defuns that
`eeurl-defuns-for-define-from' generates, so...
There are more examples in the source file. Eh, more later."
  (eval (cons 'progn (apply 'eeurl-defuns-for-define-from rest))))


;;
;; Define lots of br functions.
;; «many-br-functions»  (to ".many-br-functions")
;;

(eeurl-define-from :fname->action: 'find-fline
                   :local:         'brfl)
(eeurl-define-from :fname->action: 'eecd
                   :local:         'brcdl)
(eeurl-define-from :fname->action: 'find-pspage
                   :local:         'brgvl
                   :dired:         'brgvd)
(eeurl-define-from :fname->action: 'find-dvipage
                   :local:         'brxdvil
                   :dired:         'brxdvid)
(eeurl-define-from :fname->action: 'find-xpdfpage
                   :local:         'brxpdfl
                   :dired:         'brxpdfd)
(eeurl-define-from :fname->action: 'find-pdftotext
                   :local:         'brpdftxtl
                   :dired:         'brpdftxtd)
(eeurl-define-from :fname->action: 'find-djvupage
                   :local:         'brdjvul
                   :dired:         'brdjvud)
(eeurl-define-from :url->action:   'browse-url-firefox
		   :remote:        'brm
                   :local:         'brml
		   :dired:         'brmd)
(eeurl-define-from :url->action:   'find-w3m
		   :remote:        'brw
		   :local:         'brwl
		   :dired:         'brwd)
(eeurl-define-from :url->action:   'eepsne
		   :remote:        'brp)
(eeurl-define-from :url->action:   'eetmpwget
		   :remote:        'brtmpwget)


;; (find-efile "net/browse-url.el" "defun browse-url-firefox")
;; Delete this?
;;
;; (defun find-firefox (url &optional rest)
;;    (interactive "sURL: ")
;;    (start-process "firefox" "*Messages*" "firefox" url)
;;    url)
;;
;; (eeurl-define-from :url->action:   'find-firefox
;;                    :remote:        'brm
;;                    :local:         'brml
;;                    :dired:         'brmd)

;; http://angg.twu.net/eev-article.html#local-copies
(defun eepsne (url &rest ignore)
  (interactive (browse-url-interactive-arg "psne "))
  (eev (format "psne '%s'" url)))
 
(defun eetmpwget (url &rest ignore)
  (interactive (browse-url-interactive-arg "cd /tmp; wget "))
  (eev (concat "cd /tmp\nwget " url)))



;;;
;;; New functions added in 2007dec21.
;;; This file was already a mess, and I need these
;;; functions in eev to exchange code with a friend -
;;;
;; «find-wget»  (to ".find-wget")
;; «brwget»  (to ".brwget")
;;
(defun find-wget00 (url)
  (find-callprocess00 `("wget" "-q" "-O" "-" ,url)))

(defun find-wget (url &rest rest)
  (setq url (ee-expand url))
  (apply 'find-eoutput-reuse (format "*wget: %s*" url)
	 `(insert (find-wget00 ,url))
	 rest))

(eeurl-define-from :url->action: 'find-wget
		   :remote:      'brwget)

;; «ee-cp»  (to ".ee-cp")
;; http://article.gmane.org/gmane.emacs.bugs/17178
;;
(defun ee-cp (from to &optional ok-flag)
  (require 'dired)
  (let ((tramp-verbose 0))
    (dired-copy-file (ee-expand from) (ee-expand to) ok-flag)))

;; «find-psne-links»  (to ".find-psne-links")
;; «brep»  (to ".brep")
;; Tests:
;; (ee-psne-wget-lines "http://angg.twu.net/index.html")
;;    (find-psne-links "http://angg.twu.net/index.html")
;;               (brep "http://angg.twu.net/index.html")
;;
(defun ee-psne-wget-lines (url)
  (let* ((localurl (replace-regexp-in-string
		    "^\\(https?\\|ftp\\)://" "$S/\\1/" url))
	 (localdir (file-name-directory localurl)))
    (list (format "mkdir -p %s" localdir)
	  (format "cd       %s" localdir)
	  (format "wget     '%s'" url)
	  (format "echo     '%s' >> ~/.psne.log" url))))

(defun find-psne-links (url &rest rest)
  (find-elinks `(
    (find-psne-links ,url ,@rest)
    ;; (find-eev "eev-browse-url.el" "brep")
    ,(ee-addhp url)
    nil
    "* (eepitch-shell)"
    ,@(ee-psne-wget-lines url)
    )))

(eeurl-define-from :url->action: 'find-psne-links
                   :remote:      'brep)




(provide 'eev-browse-url)


;; (eval-buffer)

;; Ooops, this block of notes is about how I'm planning to make an
;; intro to eev using lots of screenshots, like dto did for org-mode...
;; (find-angg "bin/Xscreenshot-window")
;; http://angg.twu.net/bin/Xscreenshot-window.html
;; Oops, Mod4-w is not yet bound by default...
;; (find-angg ".fvwm/keys.fvwm")
;; http://angg.twu.net/.fvwm/keys.fvwm.html
;;
;; The parts of eev
;; ================
;; Hyperlinks
;; Hyperlink generators
;;   Temporary buffers
;;   code-c-d, find-code-c-d
;;   dff
;; Sending regions
;;   bounded regions
;; The steppers
;; Glyphs
;; Help tools
;;
;; Auxiliars
;; =========
;; The installer
;; The snarfer
;; browse-url and friends
;; hippie-expand
;;
;; file:///home/edrx/TH/L/eev-article.html

;; Old notes, random crap.
;;
;; (find-efunction 'find-w3m)
;; (find-fline "~/TH/L/")
;; (progn (find-fline "~/TH/L/") (find-w3m "01jul14.html"))


;; Local Variables:
;; coding:            raw-text-unix
;; ee-anchor-format:  "defun %s "
;; ee-anchor-format:  "«%s»"
;; no-byte-compile:   t
;; End: