# HG changeset patch # User Richard M. Stallman # Date 866342943 0 # Node ID 0c8339d10bebed4ede8622a12b7f18eb91e0f862 # Parent 9c4fb902b6ebdb4430f74be320ad7f91951051ac Update keywords to show up in finder. (browse-url-gnudoit-args, browse-url-generic-program) (browse-url-gnudoit-program, browse-url-generic-args): New variables. (browse-url-w3-gnudoit): New procedure. (browse-url-mmm): New location of `remote' file for MMM 0.4. (browse-url-generic): New procedure. (browse-url-netscape): Test for w32. (browse-url-url-at-point): Assume mailto: if URL contains @. Don't use thingatpt; find the URL here to do it correctly. (browse-url-at-point, browse-url-of-file, browse-url-at-mouse): Call browse-url. (browse-url): Check for list browse-url-browser-function. (browse-url-choose-browser): New procedure. (browse-url-browser-function): Allow list value. (browse-url-process-environment): Call browse-url-emacs-display. (browse-url-emacs-display): New procedure. (browse-url-netscape-display): New variable. (browse-url-of-region): New procedure. (browse-url-of-buffer): Check for narrowed buffer. (browse-url-url-at-point): Rewrite to not use cl.el delete-if. Fix multi-line URL matching. (browse-url-markedup-regexp): New variable. (browse-url-xterm-program): New variable. (browse-url-xterm-args): New variable. (browse-url-lynx-xterm): Use the above two vars. (browse-url-url-at-point): Use buffer-substring-no-properties. (browse-url-grail): Add missing optional arg. (browse-url-mmm): New procedure. (browse-url-netscape-startup-arguments): New variable. diff -r 9c4fb902b6eb -r 0c8339d10beb lisp/browse-url.el --- a/lisp/browse-url.el Sun Jun 15 02:41:59 1997 +0000 +++ b/lisp/browse-url.el Sun Jun 15 02:49:03 1997 +0000 @@ -1,11 +1,11 @@ -;;; browse-url.el --- ask a WWW browser to load a URL +;;; browse-url.el --- Pass a URL to a WWW browser -;; Copyright 1995, 1996 Free Software Foundation, Inc. +;; Copyright 1995, 1996, 1997 Free Software Foundation, Inc. ;; Author: Denis Howe ;; Maintainer: Dave Love ;; Created: 03 Apr 1995 -;; Keywords: hypertext +;; Keywords: hypertext, hypermedia, mouse ;; X-Home page: http://wombat.doc.ic.ac.uk/ ;; This file is part of GNU Emacs. @@ -39,17 +39,19 @@ ;; is started. Currently there is support for: ;; Function Browser Earliest version -;; browse-url-netscape Netscape 1.1b1 +;; browse-url-netscape Netscape 1.1b1 ;; browse-url-mosaic XMosaic <= 2.4 ;; browse-url-cci XMosaic 2.5 ;; browse-url-w3 w3 0 +;; browse-url-w3-gnudoit w3 remotely ;; browse-url-iximosaic IXI Mosaic ? ;; browse-url-lynx-* Lynx 0 ;; browse-url-grail Grail 0.3b1 +;; browse-url-mmm MMM ? +;; browse-url-generic arbitrary ;; Note that versions of Netscape before 1.1b1 did not have remote -;; control. -;; and . +;; control. . ;; Netscape can cache Web pages so it may be necessary to tell it to ;; reload the current page if it has changed (e.g. if you have edited @@ -71,11 +73,37 @@ ;; Emacs ;; has a function w3-follow-url-at-point, but that ;; doesn't let you edit the URL like browse-url. +;; The `gnuserv' package that can be used to control it in another +;; Emacs process is available from +;; . + +;; Grail is the freely available WWW browser implemented in Python, a +;; cool object-oriented freely available interpreted language. Grail +;; 0.3b1 was the first version to have remote control as distributed. +;; For more information on Grail see +;; and for more information on +;; Python see . Grail support in +;; browse-url.el written by Barry Warsaw . + +;; MMM is the freely available WWW browser implemented in Caml Special +;; Light, a cool impure functional programming language, by Francois +;; Rouaix. See the MMM home page +;; . + +;; Lynx is now distributed by the FSF. See also +;; . + +;; Free graphical browsers that could be used by `browse-url-generic' +;; include Chimera , Arena +;; , Amaya +;; , mMosaic +;; (the latter with +;; development support for Java applets). ;; I recommend Nelson Minar 's excellent ;; html-helper-mode.el for editing HTML and thank Nelson for ;; his many useful comments on this code. -;; +;; ;; This package generalises function html-previewer-process in Marc ;; Andreessen 's html-mode (LCD @@ -84,14 +112,6 @@ ;; (find-file-at-point) . The huge ;; hyperbole package also contains similar functions. -;; Grail is the freely available WWW browser implemented in Python, a -;; cool object-oriented freely available interpreted language. Grail -;; 0.3b1 was the first version to have remote control as distributed. -;; For more information on Grail see -;; and for more information on -;; Python see . Grail support in -;; browse-url.el written by Barry Warsaw . - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Help! @@ -105,6 +125,9 @@ ;; To display the URL at or before point: ;; M-x browse-url-at-point RET +;; or, similarly but with the opportunity to edit the URL extracted from +;; the buffer, use: +;; M-x browse-url ;; To display a URL by shift-clicking on it, put this in your ~/.emacs ;; file: @@ -115,6 +138,9 @@ ;; To display the current buffer in a web browser: ;; M-x browse-url-of-buffer RET +;; To display the current region in a web browser: +;; M-x browse-url-of-region RET + ;; In Dired, to display the file named on the current line: ;; M-x browse-url-of-dired-file RET @@ -128,9 +154,10 @@ ;; (as used by html-helper-mode): ;; (global-set-key "\C-c\C-z." 'browse-url-at-point) ;; (global-set-key "\C-c\C-zb" 'browse-url-of-buffer) +;; (global-set-key "\C-c\C-zr" 'browse-url-of-region) ;; (global-set-key "\C-c\C-zu" 'browse-url) ;; (global-set-key "\C-c\C-zv" 'browse-url-of-file) -;; (add-hook 'dired-mode-hook +;; (add-hook 'dired-mode-hook ;; (function (lambda () ;; (local-set-key "\C-c\C-zf" 'browse-url-of-dired-file)))) @@ -144,150 +171,47 @@ ;; Use the Emacs w3 browser when not running under X11: ;; (or (eq window-system 'x) -;; (setq browse-url-browser-function 'browse-url-w3)) +;; (setq browse-url-browser-function 'browse-url-w3)) ;; To always save modified buffers before displaying the file in a browser: -;; (setq browse-url-save-file t) +;; (setq browse-url-save-file t) ;; To get round the Netscape caching problem, you could EITHER have ;; write-file in html-helper-mode make Netscape reload the document: ;; -;; (autoload 'browse-url-netscape-reload "browse-url" -;; "Ask a WWW browser to redisplay the current file." t) -;; (add-hook 'html-helper-mode-hook -;; (function (lambda () -;; (add-hook 'local-write-file-hooks -;; (function (lambda () -;; (let ((local-write-file-hooks)) -;; (save-buffer)) -;; (browse-url-netscape-reload) -;; t)) ; => file written by hook -;; t)))) ; append to l-w-f-hooks +;; (autoload 'browse-url-netscape-reload "browse-url" +;; "Ask a WWW browser to redisplay the current file." t) +;; (add-hook 'html-helper-mode-hook +;; (function (lambda () +;; (add-hook 'local-write-file-hooks +;; (function (lambda () +;; (let ((local-write-file-hooks)) +;; (save-buffer)) +;; (browse-url-netscape-reload) +;; t)) ; => file written by hook +;; t)))) ; append to l-w-f-hooks ;; ;; OR have browse-url-of-file ask Netscape to load and then reload the ;; file: ;; -;; (add-hook 'browse-url-of-file-hook 'browse-url-netscape-reload) +;; (add-hook 'browse-url-of-file-hook 'browse-url-netscape-reload) ;; You may also want to customise browse-url-netscape-arguments, e.g. -;; (setq browse-url-netscape-arguments '("-install")) +;; (setq browse-url-netscape-arguments '("-install")) ;; -;; or similarly for the other browsers. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Change Log: - -;; 0.00 03 Apr 1995 Denis Howe -;; Created. - -;; 0.01 04 Apr 1995 -;; All names start with "browse-url-". Added provide. - -;; 0.02 05 Apr 1995 -;; Save file at start of browse-url-of-file. -;; Use start-process instead of start-process-shell-command. - -;; 0.03 06 Apr 1995 -;; Add browse-url-netscape-reload, browse-url-netscape-send. -;; browse-url-of-file save file option. - -;; 0.04 08 Apr 1995 -;; b-u-file-url separate function. Change b-u-filename-alist -;; default. - -;; 0.05 09 Apr 1995 -;; Added b-u-of-file-hook. - -;; 0.06 11 Apr 1995 -;; Improved .emacs suggestions and documentation. - -;; 0.07 13 Apr 1995 -;; Added browse-url-interactive-arg optional prompt. - -;; 0.08 18 Apr 1995 -;; Exclude final "." from browse-url-regexp. - -;; 0.09 21 Apr 1995 -;; Added mouse-set-point to browse-url-interactive-arg. - -;; 0.10 24 Apr 1995 -;; Added Mosaic signal sending variations. -;; Thanks Brian K Servis . -;; Don't use xprop for Netscape. +;; or similarly for the other browsers. -;; 0.11 25 Apr 1995 -;; Fix reading of ~/.mosaicpid. Thanks Dag.H.Wanvik@kvatro.no. - -;; 0.12 27 Apr 1995 -;; Interactive prefix arg => URL *after* point. -;; Thanks Michelangelo Grigni . -;; Added IXI Mosaic support. -;; Thanks David Karr . - -;; 0.13 28 Apr 1995 -;; Exclude final [,;] from browse-url-regexp. - -;; 0.14 02 May 1995 -;; Provide browser argument variables. - -;; 0.15 07 May 1995 -;; More Netscape options. Thanks Peter Arius -;; . - -;; 0.16 17 May 1995 -;; Added browse-url-at-mouse. -;; Thanks Wayne Mesard - -;; 0.17 27 Jun 1995 -;; Renamed browse-url-at-point to browse-url-url-at-point. -;; Added browse-url-at-point. -;; Thanks Jonathan Cano . - -;; 0.18 16 Aug 1995 -;; Fixed call to browse-url-url-at-point in browse-url-at-point. -;; Thanks Eric Ding . - -;; 0.19 24 Aug 1995 -;; Improved documentation. -;; Thanks Kevin Rodgers . - -;; 0.20 31 Aug 1995 -;; browse-url-of-buffer to handle file-less buffers. -;; browse-url-of-dired-file browses current file in dired. -;; Thanks Kevin Rodgers . - -;; 0.21 09 Sep 1995 -;; XMosaic CCI functions. -;; Thanks Marc Furrer . - -;; 0.22 13 Sep 1995 -;; Fixed new-window documentation and added to browse-url-cci. -;; Thanks Dilip Sequeira . +;; To invoke different browsers for different URLs: +;; (setq browse-url-browser-function '(("^mailto:" . browse-url-mail) +;; ("." . browse-url-netscape))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Code: -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Variables - (eval-when-compile (require 'dired)) -(defvar browse-url-path-regexp - "[^]\t\n \"'()<>[^`{}]*[^]\t\n \"'()<>[^`{}.,;]+" - "A regular expression probably matching the host, path or e-mail -part of a URL.") - -(defvar browse-url-short-regexp - (concat "[-A-Za-z0-9.]+" browse-url-path-regexp) - "A regular expression probably matching a URL without an access scheme. -Hostname matching is stricter in this case than for -``browse-url-regexp''.") - -(defvar browse-url-regexp - (concat - "\\(https?://\\|ftp://\\|gopher://\\|telnet://\\|wais://\\|file:/\\|s?news:\\|mailto:\\)" - browse-url-path-regexp) - "A regular expression probably matching a complete URL.") +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Variables ;;;###autoload (defgroup browse-url nil @@ -300,7 +224,12 @@ "*Function to display the current buffer in a WWW browser. This is used by the `browse-url-at-point', `browse-url-at-mouse', and `browse-url-of-file' commands. -The function should take one argument, an URL." + +If the value is not a function it should be a list of pairs +(REGEXP.FUNCTION). In this case the function called will be the one +associated with the first REGEXP which matches the current URL. The +function is passed the URL and any other args of `browse-url'. The last +regexp should probably be \".\" to specify a default browser." :type 'function :group 'browse-url) @@ -317,7 +246,7 @@ (defcustom browse-url-netscape-startup-arguments browse-url-netscape-arguments "*A list of strings to pass to Netscape when it starts up. Defaults to the value of `browse-url-netscape-arguments' at the time -browse-url is loaded." +`browse-url' is loaded." :type '(repeat (string :tag "Argument")) :group 'browse-url) @@ -329,18 +258,53 @@ :type 'boolean :group 'browse-url) +(defcustom browse-url-netscape-display nil + "*The X display on which Netscape is running if different from + Emacs's display." + :type 'string + :group 'browse-url) + (defcustom browse-url-mosaic-arguments nil "*A list of strings to pass to Mosaic as arguments." :type '(repeat (string :tag "Argument")) :group 'browse-url) +(defvar browse-url-path-regexp + "[^]\t\n \"'()<>[^`{}]*[^]\t\n \"'()<>[^`{}.,;]+" + "A regular expression probably matching the host, path or e-mail part of a URL.") + +(defvar browse-url-short-regexp + (concat "[-A-Za-z0-9.]+" browse-url-path-regexp) + "A regular expression probably matching a URL without an access scheme. +Hostname matching is stricter in this case than for +``browse-url-regexp''.") + +(defvar browse-url-regexp + (concat + "\\(https?://\\|ftp://\\|gopher://\\|telnet://\\|wais://\\|file:/\\|s?news:\\|mailto:\\)" + browse-url-path-regexp) + "A regular expression probably matching a complete URL.") + +(defvar browse-url-markedup-regexp + "]+>" + "A regular expression matching a URL marked up per RFC1738. +This may be broken across lines.") + (defvar browse-url-filename-alist '(("^/+" . "file:/")) "An alist of (REGEXP . STRING) pairs. Any substring of a filename matching one of the REGEXPs is replaced by the corresponding STRING. All pairs are applied in the order given. The default value prepends `file:' to any path beginning with `/'. -Used by the `browse-url-of-file' command.") +Used by the `browse-url-of-file' command. + +For example, to map EFS filenames to URLs: + + (setq browse-url-filename-alist + '((\"/webmaster@webserver:/home/www/html/\" . + \"http://www.acme.co.uk/\") + (\"^/+\" . \"file:/\"))) +") (defvar browse-url-save-file nil "If non-nil, save the buffer before displaying its file. @@ -355,9 +319,9 @@ (defvar browse-url-usr1-signal (if (and (boundp 'emacs-major-version) - (or (> emacs-major-version 19) (>= emacs-minor-version 29))) + (or (> emacs-major-version 19) (>= emacs-minor-version 29))) 'SIGUSR1 ; Why did I think this was in lower case before? - 30) ; Check /usr/include/signal.h. + 30) ; Check /usr/include/signal.h. "The argument to `signal-process' for sending SIGUSR1 to XMosaic. Emacs 19.29 accepts 'SIGUSR1, earlier versions require an integer which is 30 on SunOS and 16 on HP-UX and Solaris.") @@ -375,22 +339,99 @@ (defvar browse-url-temp-file-name nil) (make-variable-buffer-local 'browse-url-temp-file-name) +(defcustom browse-url-xterm-program "xterm" + "*The name of the terminal emulator used by `browse-url-lynx-xterm'. +This might, for instance, be a separate colour version of xterm." + :type 'string + :group 'browse-url) + +(defcustom browse-url-xterm-args nil + "*A list of strings defining options for `browse-url-xterm-program'. +These might set its size, for instance." + :type '(repeat (string :tag "Argument")) + :group 'browse-url) + +(defcustom browse-url-gnudoit-program "gnudoit" + "*The name of the `gnudoit' program used by `browse-url-w3-gnudoit'." + :type 'string + :group 'browse-url) + +(defcustom browse-url-gnudoit-args '("-q") + "*A list of strings defining options for `browse-url-gnudoit-program'. +These might set the port, for instance." + :type '(repeat (string :tag "Argument")) + :group 'browse-url) + +(defcustom browse-url-generic-program nil + "*The name of the browser program used by `browse-url-generic'." + :type 'string + :group 'browse-url) + +(defcustom browse-url-generic-args nil + "*A list of strings defining options for `browse-url-generic-program'." + :type '(repeat (string :tag "Argument")) + :group 'browse-url) + (defvar browse-url-temp-file-list '()) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; URL input -;; thingatpt.el doesn't work for complex regexps - (defun browse-url-url-at-point () "Return the URL around or before point. Search backwards for the start of a URL ending at or after -point. If no URL found, return the empty string. -A file name is also acceptable, and `http://' will be prepended to it." - (or (thing-at-point 'url) - (let ((file (thing-at-point 'filename))) - (if file (concat "http://" file))) - "")) +point. If no URL found, return the empty string. The +access scheme, `http://' will be prepended if absent." + (let ((url "") short strip) + (if (or (setq strip (browse-url-looking-at browse-url-markedup-regexp)) + (browse-url-looking-at browse-url-regexp) + ;; Access scheme omitted? + (setq short (browse-url-looking-at browse-url-short-regexp))) + (progn + (setq url (buffer-substring-no-properties (match-beginning 0) + (match-end 0))) + (and strip (setq url (substring url 5 -1))) ; Drop "" + ;; strip whitespace + (while (string-match "\\s +\\|\n+" url) + (setq url (replace-match "" t t url))) + (and short (setq url (concat (if (string-match "@" url) + "mailto:" "http://") url))))) + url)) + +;; thingatpt.el doesn't work for complex regexps. This should work +;; for almost any regexp wherever we are in the match. To do a +;; perfect job for any arbitrary regexp would mean testing every +;; position before point. Regexp searches won't find matches that +;; straddle the start position so we search forwards once and then +;; back repeatedly and then back up a char at a time. + +(defun browse-url-looking-at (regexp) + "Return non-nil if point is in or just after a match for REGEXP. +Set the match data from the earliest such match ending at or after +point." + (save-excursion + (let ((old-point (point)) match) + (and (looking-at regexp) + (>= (match-end 0) old-point) + (setq match (point))) + ;; Search back repeatedly from end of next match. + ;; This may fail if next match ends before this match does. + (re-search-forward regexp nil 'limit) + (while (and (re-search-backward regexp nil t) + (or (> (match-beginning 0) old-point) + (and (looking-at regexp) ; Extend match-end past search start + (>= (match-end 0) old-point) + (setq match (point)))))) + (if (not match) nil + (goto-char match) + ;; Back up a char at a time in case search skipped + ;; intermediate match straddling search start pos. + (while (and (not (bobp)) + (progn (backward-char 1) (looking-at regexp)) + (>= (match-end 0) old-point) + (setq match (point)))) + (goto-char match) + (looking-at regexp))))) ;; Having this as a separate function called by the browser-specific ;; functions allows them to be stand-alone commands, making it easier @@ -400,7 +441,7 @@ "Read a URL from the minibuffer, prompting with PROMPT. Default to the URL at or before point. If invoke with a mouse button, set point to the position clicked first. Return a list for use in -`interactive' containing the URL and browse-url-new-window-p or its +`interactive' containing the URL and `browse-url-new-window-p' or its negation if a prefix argument was given." (let ((event (elt (this-command-keys) 0))) (and (listp event) (mouse-set-point event))) @@ -416,20 +457,20 @@ "Ask a WWW browser to display FILE. Display the current buffer's file if FILE is nil or if called interactively. Turn the filename into a URL with function -browse-url-file-url. Pass the URL to a browser using variable -`browse-url-browser-function' then run `browse-url-of-file-hook'." +`browse-url-file-url'. Pass the URL to a browser using the +`browse-url' function then run `browse-url-of-file-hook'." (interactive) - (or file + (or file (setq file (buffer-file-name)) (error "Current buffer has no file")) (let ((buf (get-file-buffer file))) (if buf - (save-excursion - (set-buffer buf) - (cond ((not (buffer-modified-p))) - (browse-url-save-file (save-buffer)) - (t (message "%s modified since last save" file)))))) - (funcall browse-url-browser-function (browse-url-file-url file)) + (save-excursion + (set-buffer buf) + (cond ((not (buffer-modified-p))) + (browse-url-save-file (save-buffer)) + (t (message "%s modified since last save" file)))))) + (browse-url (browse-url-file-url file)) (run-hooks 'browse-url-of-file-hook)) (defun browse-url-file-url (file) @@ -447,9 +488,9 @@ (let ((maps browse-url-filename-alist)) (while maps (let* ((map (car maps)) - (from-re (car map)) - (to-string (cdr map))) - (setq maps (cdr maps)) + (from-re (car map)) + (to-string (cdr map))) + (setq maps (cdr maps)) (and (string-match from-re file) (setq file (replace-match to-string t t file)))))) ;; Check for EFS path @@ -462,22 +503,26 @@ ;;;###autoload (defun browse-url-of-buffer (&optional buffer) "Ask a WWW browser to display BUFFER. -Display the current buffer if BUFFER is nil." +Display the current buffer if BUFFER is nil. Display only the +currently visible part of BUFFER (from a temporary file) if buffer is +narrowed." (interactive) (save-excursion (and buffer (set-buffer buffer)) (let ((file-name - (or buffer-file-name - (and (boundp 'dired-directory) dired-directory)))) + ;; Ignore real name if restricted + (and (= (- (point-max) (point-min)) (buffer-size)) + (or buffer-file-name + (and (boundp 'dired-directory) dired-directory))))) (or file-name - (progn + (progn (or browse-url-temp-file-name - (setq browse-url-temp-file-name - (make-temp-name - (expand-file-name (buffer-name) + (setq browse-url-temp-file-name + (make-temp-name + (expand-file-name (buffer-name) (or (getenv "TMPDIR") "/tmp"))) browse-url-temp-file-list - (cons browse-url-temp-file-name + (cons browse-url-temp-file-name browse-url-temp-file-list))) (setq file-name browse-url-temp-file-name) (write-region (point-min) (point-max) file-name nil 'no-message))) @@ -490,19 +535,19 @@ ;; browse-url-temp-file-list is not affected. (let ((file-name (or temp-file-name browse-url-temp-file-name))) (if (and file-name (file-exists-p file-name)) - (progn - (delete-file file-name) - (if (null temp-file-name) - (setq browse-url-temp-file-list - (delete browse-url-temp-file-name - browse-url-temp-file-list))))))) + (progn + (delete-file file-name) + (if (null temp-file-name) + (setq browse-url-temp-file-list + (delete browse-url-temp-file-name + browse-url-temp-file-list))))))) (defun browse-url-delete-temp-file-list () ;; Delete all elements of browse-url-temp-file-list. (while browse-url-temp-file-list (browse-url-delete-temp-file (car browse-url-temp-file-list)) (setq browse-url-temp-file-list - (cdr browse-url-temp-file-list)))) + (cdr browse-url-temp-file-list)))) (add-hook 'kill-buffer-hook 'browse-url-delete-temp-file) (add-hook 'kill-emacs-hook 'browse-url-delete-temp-file-list) @@ -513,17 +558,44 @@ (interactive) (browse-url-of-file (dired-get-filename))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Browser-independant commands +;;;###autoload +(defun browse-url-of-region (min max) + "Ask a WWW browser to display the current region." + (interactive "r") + (save-excursion + (save-restriction + (narrow-to-region (mark) (point)) + (browse-url-of-buffer)))) -;; A generic command to call the current b-u-browser-function +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Browser-independent commands +;; A generic command to call the current browse-url-browser-function + +;;;###autoload (defun browse-url (&rest args) "Ask a WWW browser to load URL. Prompts for a URL, defaulting to the URL at or before point. Variable `browse-url-browser-function' says which browser to use." (interactive (browse-url-interactive-arg "URL: ")) - (apply browse-url-browser-function args)) + (if (consp browse-url-browser-function) + (browse-url-choose-browser args) + (apply browse-url-browser-function args))) + +(defun browse-url-choose-browser (url &rest args) + "Pass URL to a browser function chosen. +This is done according to the association list in variable +`browse-url-browser-function'." + (let ((blist browse-url-browser-function) + re bf) + (while (consp blist) + (setq re (car (car blist)) + bf (cdr (car blist)) + blist (cdr blist)) + (if (string-match re url) + (progn (apply bf url args) (setq blist t)))) + (or blist + (error "No browser in browse-url-browser-function matching URL %s" url)))) ;;;###autoload (defun browse-url-at-point () @@ -531,9 +603,7 @@ Doesn't let you edit the URL like browse-url. Variable `browse-url-browser-function' says which browser to use." (interactive) - (funcall browse-url-browser-function (browse-url-url-at-point))) - -;; Define these if not already defined (XEmacs compatibility) + (browse-url (browse-url-url-at-point))) (defun browse-url-event-buffer (event) (window-buffer (posn-window (event-start event)))) @@ -555,30 +625,38 @@ (let ((url (browse-url-url-at-point))) (if (string-equal url "") (error "No URL found")) - (funcall browse-url-browser-function url)))) + (browse-url url)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Browser-specific commands ;; --- Netscape --- -;; Put the correct DISPLAY value in the environment for Netscape -;; launched from multi-display Emacs. - (defun browse-url-process-environment () - (let* ((device (and (fboundp 'selected-device) - (fboundp 'device-connection) - (selected-device))) - (display (and device (fboundp 'device-type) - (eq (device-type device) 'x) - (not (equal (device-connection device) - (getenv "DISPLAY")))))) + "Set DISPLAY in the environment to the X display Netscape is running on. +This is either the value of variable `browse-url-netscape-display' if +non-nil, or the same display as Emacs if different from the current +environment, otherwise just use the current environment." + (let ((display (or browse-url-netscape-display (browse-url-emacs-display)))) (if display - ;; Attempt to run on the correct display - (cons (concat "DISPLAY=" (device-connection device)) - process-environment) + (cons (concat "DISPLAY=" display) process-environment) process-environment))) +(defun browse-url-emacs-display () + "Return the X display Emacs is running on. +This nil if the display is the same as the DISPLAY environment variable. + +Actually Emacs could be using several screens on several displays, as +listed by (emacs-display-list) and (x-display-screens DISPLAY), this +just returns the display showing the selected frame. You got a +problem with that?" + (let (device display) + (and (fboundp 'selected-device) (fboundp 'device-type) (fboundp 'device-connection) + (setq device (selected-device)) + (eq (device-type device) 'x) + (setq display (device-connection device)) + (not (equal display (getenv "DISPLAY"))) + display))) ;;;###autoload (defun browse-url-netscape (url &optional new-window) @@ -590,10 +668,10 @@ When called interactively, if variable `browse-url-new-window-p' is non-nil, load the document in a new Netscape window, otherwise use a random existing one. A non-nil interactive prefix argument reverses -the effect of browse-url-new-window-p. +the effect of `browse-url-new-window-p'. When called non-interactively, optional second argument NEW-WINDOW is -used instead of browse-url-new-window-p." +used instead of `browse-url-new-window-p'." (interactive (browse-url-interactive-arg "Netscape URL: ")) ;; URL encode any commas in the URL (while (string-match "," url) @@ -602,22 +680,24 @@ (process (apply 'start-process (concat "netscape " url) nil browse-url-netscape-program - (append browse-url-netscape-arguments - (if new-window '("-noraise")) - (list "-remote" - (concat "openURL(" url - (if new-window ",new-window") - ")")))))) + (append browse-url-netscape-arguments + (if (string-equal "win32" window-system) + (list url) + (if new-window '("-noraise")) + (list "-remote" + (concat "openURL(" url + (if new-window ",new-window") + ")"))))))) (set-process-sentinel process - (list 'lambda '(process change) - (list 'browse-url-netscape-sentinel 'process url))))) + (list 'lambda '(process change) + (list 'browse-url-netscape-sentinel 'process url))))) (defun browse-url-netscape-sentinel (process url) "Handle a change to the process communicating with Netscape." (or (eq (process-exit-status process) 0) (let* ((process-environment (browse-url-process-environment))) ;; Netscape not running - start it - (message "Starting Netscape...") + (message "Starting Netscape...") (apply 'start-process (concat "netscape" url) nil browse-url-netscape-program (append browse-url-netscape-startup-arguments (list url)))))) @@ -632,7 +712,7 @@ (let* ((process-environment (browse-url-process-environment))) (apply 'start-process "netscape" nil browse-url-netscape-program - (append browse-url-netscape-arguments + (append browse-url-netscape-arguments (list "-remote" command))))) ;; --- Mosaic --- @@ -644,31 +724,31 @@ Default to the URL around or before point." (interactive (browse-url-interactive-arg "Mosaic URL: ")) (let ((pidfile (expand-file-name "~/.mosaicpid")) - pid pidbuf) + pid pidbuf) (if (file-readable-p pidfile) - (save-excursion - (find-file pidfile) - (goto-char (point-min)) - (setq pid (read (current-buffer))) - (kill-buffer nil))) + (save-excursion + (find-file pidfile) + (goto-char (point-min)) + (setq pid (read (current-buffer))) + (kill-buffer nil))) (if (and pid (zerop (signal-process pid 0))) ; Mosaic running - (save-excursion - (find-file (format "/tmp/Mosaic.%d" pid)) - (erase-buffer) - (insert "goto\n" url "\n") - (save-buffer) - (kill-buffer nil) - ;; Send signal SIGUSR to Mosaic + (save-excursion + (find-file (format "/tmp/Mosaic.%d" pid)) + (erase-buffer) + (insert "goto\n" url "\n") + (save-buffer) + (kill-buffer nil) + ;; Send signal SIGUSR to Mosaic (message "Signalling Mosaic...") - (signal-process pid browse-url-usr1-signal) - ;; Or you could try: - ;; (call-process "kill" nil 0 nil "-USR1" (int-to-string pid)) + (signal-process pid browse-url-usr1-signal) + ;; Or you could try: + ;; (call-process "kill" nil 0 nil "-USR1" (int-to-string pid)) (message "Signalling Mosaic...done") - ) + ) ;; Mosaic not running - start it (message "Starting Mosaic...") (apply 'start-process "xmosaic" nil "xmosaic" - (append browse-url-mosaic-arguments (list url))) + (append browse-url-mosaic-arguments (list url))) (message "Starting Mosaic...done")))) ;; --- Grail --- @@ -680,7 +760,7 @@ Typically found in $GRAILDIR/rcgrail.py, or ~/.grail/user/rcgrail.py.") ;;;###autoload -(defun browse-url-grail (url) +(defun browse-url-grail (url &optional new-window) "Ask the Grail WWW browser to load URL. Default to the URL around or before point. Runs the program in the variable `browse-url-grail'." @@ -706,17 +786,17 @@ When called interactively, if variable `browse-url-new-window-p' is non-nil, load the document in a new browser window, otherwise use a random existing one. A non-nil interactive prefix argument reverses -the effect of browse-url-new-window-p. +the effect of `browse-url-new-window-p'. When called non-interactively, optional second argument NEW-WINDOW is -used instead of browse-url-new-window-p." +used instead of `browse-url-new-window-p'." (interactive (browse-url-interactive-arg "Mosaic URL: ")) (open-network-stream "browse-url" " *browse-url*" browse-url-CCI-host browse-url-CCI-port) ;; Todo: start browser if fails (process-send-string "browse-url" - (concat "get url (" url ") output " - (if new-window "new" "current") "\r\n")) + (concat "get url (" url ") output " + (if new-window "new" "current") "\r\n")) (process-send-string "browse-url" "disconnect\r\n") (delete-process "browse-url")) @@ -729,7 +809,7 @@ Default to the URL around or before point." (interactive (browse-url-interactive-arg "IXI Mosaic URL: ")) (start-process "tellw3b" nil "tellw3b" - "-service WWW_BROWSER ixi_showurl " url)) + "-service WWW_BROWSER ixi_showurl " url)) ;; --- W3 --- @@ -741,6 +821,17 @@ (interactive (browse-url-interactive-arg "W3 URL: ")) (w3-fetch url)) +;;;###autoload +(defun browse-url-w3-gnudoit (url &optional new-window) + ;; new-window ignored + "Ask another Emacs running gnuserv to load the URL using the W3 browser. +The `browse-url-gnudoit-program' program is used with options given by +`browse-url-gnudoit-args'. Default to the URL around or before point." + (interactive (browse-url-interactive-arg "W3 URL: ")) + (apply 'start-process (concat "gnudoit:" url) nil + browse-url-gnudoit-program + (append browse-url-gnudoit-args (list (concat "(w3-fetch \"" url "\")") "(raise-frame)")))) + ;; --- Lynx in an xterm --- ;;;###autoload @@ -748,9 +839,11 @@ ;; new-window ignored "Ask the Lynx WWW browser to load URL. Default to the URL around or before point. A new Lynx process is run -in an Xterm window." +in an Xterm window using the Xterm program named by `browse-url-xterm-program' +with possible additional arguments `browse-url-xterm-args'." (interactive (browse-url-interactive-arg "Lynx URL: ")) - (start-process (concat "lynx" url) nil "xterm" "-e" "lynx" url)) + (apply 'start-process (concat "lynx" url) nil browse-url-xterm-program + (append browse-url-xterm-args (list "-e" "lynx" url)))) ;; --- Lynx in an Emacs "term" window --- @@ -770,6 +863,57 @@ (switch-to-buffer "*browse-url*")) (terminal-emulator "*browse-url*" "lynx" (list url))))) +;; --- MMM --- + +;;;###autoload +(defun browse-url-mmm (url &optional new-window) + "Ask the MMM WWW browser to load URL. +Default to the URL around or before point." + (interactive (browse-url-interactive-arg "MMM URL: ")) + (message "Sending URL to MMM...") + (save-excursion + (set-buffer (get-buffer-create " *Shell Command Output*")) + (erase-buffer) + ;; mmm_remote just SEGVs if the file isn't there... + (if (or (file-exists-p (expand-file-name "~/.mmm_remote")) + ;; location in v 0.4: + (file-exists-p (expand-file-name "~/.mmm/remote"))) + (call-process "mmm_remote" nil 0 nil url) + (call-process "mmm" nil 0 nil "-external" url)) + (message "Sending URL to MMM... done"))) + +;; --- mailto --- + +;;;###autoload +(defun browse-url-mail (url) + "Open a new mail message buffer within Emacs. +Default to the mailto URL around or before point." + (interactive (browse-url-interactive-arg "Mailto URL: ")) + (save-excursion + ;; open mail buffer, specifying TO and REPLYBUFFER + (mail nil (if (string-match "^mailto:" url) + (substring url 7) + url) + nil nil nil + (current-buffer)))) + +;; --- Random browser --- + +;;;###autoload +(defun browse-url-generic (url &optional new-window) + ;; new-window ignored + "Ask the WWW browser defined by `browse-url-generic-program' to load URL. +Default to the URL around or before point. A fresh copy of the +browser is started up in a new process with possible additional arguments +`browse-url-generic-args'. This is appropriate for browsers which +don't offer a form of remote control." + (interactive (browse-url-interactive-arg "URL: ")) + (if (not browse-url-generic-program) + (error "No browser defined (`browse-url-generic-program')")) + (apply 'start-process (concat browse-url-generic-program url) nil + browse-url-generic-program + (append browse-url-generic-args (list url)))) + (provide 'browse-url) ;;; browse-url.el ends here