Mercurial > emacs
comparison lisp/net/browse-url.el @ 84623:5c69a4b491f6
(browse-url-url-encode-chars): New function.
URL-encode some chars in a string.
(browse-url-encode-url): Rewrite using the previous function.
(browse-url-file-url): Use `browse-url-url-encode-chars'.
(browse-url-elinks-sentinel): Fix typo.
(browse-url-new-window-flag): Doc change.
author | Michaël Cadilhac <michael.cadilhac@lrde.org> |
---|---|
date | Mon, 17 Sep 2007 15:59:41 +0000 |
parents | c431e16c1635 |
children | ea4647942299 |
comparison
equal
deleted
inserted
replaced
84622:f967b253f826 | 84623:5c69a4b491f6 |
---|---|
70 | 70 |
71 ;; Netscape allows you to specify the id of the window you want to | 71 ;; Netscape allows you to specify the id of the window you want to |
72 ;; control but which window DO you want to control and how do you | 72 ;; control but which window DO you want to control and how do you |
73 ;; discover its id? | 73 ;; discover its id? |
74 | 74 |
75 ;; William M. Perry's excellent "w3" WWW browser for | 75 ;; William M. Perry's excellent "w3" WWW browser for |
76 ;; Emacs <URL:ftp://cs.indiana.edu/pub/elisp/w3/> | 76 ;; Emacs <URL:ftp://cs.indiana.edu/pub/elisp/w3/> |
77 ;; has a function w3-follow-url-at-point, but that | 77 ;; has a function w3-follow-url-at-point, but that |
78 ;; doesn't let you edit the URL like browse-url. | 78 ;; doesn't let you edit the URL like browse-url. |
79 ;; The `gnuserv' package that can be used to control it in another | 79 ;; The `gnuserv' package that can be used to control it in another |
80 ;; Emacs process is available from | 80 ;; Emacs process is available from |
428 window." | 428 window." |
429 :type 'boolean | 429 :type 'boolean |
430 :group 'browse-url) | 430 :group 'browse-url) |
431 | 431 |
432 (defcustom browse-url-new-window-flag nil | 432 (defcustom browse-url-new-window-flag nil |
433 "If non-nil, always open a new browser window with appropriate browsers. | 433 "Non-nil means always open a new browser window with appropriate browsers. |
434 Passing an interactive argument to \\[browse-url], or specific browser | 434 Passing an interactive argument to \\[browse-url], or specific browser |
435 commands reverses the effect of this variable. Requires Netscape version | 435 commands reverses the effect of this variable. Requires Netscape version |
436 1.1N or later or XMosaic version 2.5 or later if using those browsers." | 436 1.1N or later or XMosaic version 2.5 or later if using those browsers." |
437 :type 'boolean | 437 :type 'boolean |
438 :group 'browse-url) | 438 :group 'browse-url) |
617 :group 'browse-url) | 617 :group 'browse-url) |
618 | 618 |
619 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 619 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
620 ;; URL encoding | 620 ;; URL encoding |
621 | 621 |
622 (defun browse-url-encode-url (url &optional filename-p) | 622 (defun browse-url-url-encode-chars (text chars) |
623 "Encode all `confusing' characters in URL. | 623 "URL-encode the chars in TEXT that match CHARS. |
624 If FILENAME-P is nil, the confusing characters are [,)$]. | 624 CHARS is a regexp-like character alternative (e.g., \"[,)$]\")." |
625 Otherwise, the confusing characters are [*\"()',=;?% ]." | 625 (let ((encoded-url (copy-sequence url)) |
626 (let ((conf-char (if filename-p "[*\"()',=;?% ]" "[,)$]")) | |
627 (encoded-url (copy-sequence url)) | |
628 (s 0)) | 626 (s 0)) |
629 (while (setq s (string-match conf-char encoded-url s)) | 627 (while (setq s (string-match chars encoded-url s)) |
630 (setq encoded-url | 628 (setq encoded-url |
631 (replace-match (format "%%%x" | 629 (replace-match (format "%%%x" |
632 (string-to-char (match-string 0 encoded-url))) | 630 (string-to-char (match-string 0 encoded-url))) |
633 t t encoded-url) | 631 t t encoded-url) |
634 s (1+ s))) | 632 s (1+ s))) |
635 encoded-url)) | 633 encoded-url)) |
634 | |
635 (defun browse-url-encode-url (url) | |
636 "Escape annoying characters in URL. | |
637 The annoying characters are those that can mislead a webbrowser | |
638 regarding its parameter treatment. For instance, `,' can | |
639 be misleading because it could be used to separate URLs." | |
640 (browse-url-url-encode-chars url "[,)$]")) | |
636 | 641 |
637 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 642 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
638 ;; URL input | 643 ;; URL input |
639 | 644 |
640 ;;;###autoload | 645 ;;;###autoload |
704 Use variable `browse-url-filename-alist' to map filenames to URLs." | 709 Use variable `browse-url-filename-alist' to map filenames to URLs." |
705 (let ((coding (and default-enable-multibyte-characters | 710 (let ((coding (and default-enable-multibyte-characters |
706 (or file-name-coding-system | 711 (or file-name-coding-system |
707 default-file-name-coding-system)))) | 712 default-file-name-coding-system)))) |
708 (if coding (setq file (encode-coding-string file coding)))) | 713 (if coding (setq file (encode-coding-string file coding)))) |
709 (setq file (browse-url-encode-url file 'url-is-filename)) | 714 (setq file (browse-url-url-encode-chars file "[*\"()',=;?% ]")) |
710 (dolist (map browse-url-filename-alist) | 715 (dolist (map browse-url-filename-alist) |
711 (when (and map (string-match (car map) file)) | 716 (when (and map (string-match (car map) file)) |
712 (setq file (replace-match (cdr map) t nil file)))) | 717 (setq file (replace-match (cdr map) t nil file)))) |
713 file) | 718 file) |
714 | 719 |
876 | 881 |
877 The order attempted is gnome-moz-remote, Mozilla, Firefox, | 882 The order attempted is gnome-moz-remote, Mozilla, Firefox, |
878 Galeon, Konqueror, Netscape, Mosaic, IXI Mosaic, Lynx in an | 883 Galeon, Konqueror, Netscape, Mosaic, IXI Mosaic, Lynx in an |
879 xterm, MMM, and then W3." | 884 xterm, MMM, and then W3." |
880 (apply | 885 (apply |
881 (cond | 886 (cond |
882 ((executable-find browse-url-gnome-moz-program) 'browse-url-gnome-moz) | 887 ((executable-find browse-url-gnome-moz-program) 'browse-url-gnome-moz) |
883 ((executable-find browse-url-mozilla-program) 'browse-url-mozilla) | 888 ((executable-find browse-url-mozilla-program) 'browse-url-mozilla) |
884 ((executable-find browse-url-firefox-program) 'browse-url-firefox) | 889 ((executable-find browse-url-firefox-program) 'browse-url-firefox) |
885 ((executable-find browse-url-galeon-program) 'browse-url-galeon) | 890 ((executable-find browse-url-galeon-program) 'browse-url-galeon) |
886 ((executable-find browse-url-kde-program) 'browse-url-kde) | 891 ((executable-find browse-url-kde-program) 'browse-url-kde) |
887 ((executable-find browse-url-netscape-program) 'browse-url-netscape) | 892 ((executable-find browse-url-netscape-program) 'browse-url-netscape) |
888 ((executable-find browse-url-mosaic-program) 'browse-url-mosaic) | 893 ((executable-find browse-url-mosaic-program) 'browse-url-mosaic) |
889 ((executable-find "tellw3b") 'browse-url-iximosaic) | 894 ((executable-find "tellw3b") 'browse-url-iximosaic) |
890 ((executable-find browse-url-xterm-program) 'browse-url-lynx-xterm) | 895 ((executable-find browse-url-xterm-program) 'browse-url-lynx-xterm) |
891 ((executable-find "mmm") 'browse-url-mmm) | 896 ((executable-find "mmm") 'browse-url-mmm) |
892 ((locate-library "w3") 'browse-url-w3) | 897 ((locate-library "w3") 'browse-url-w3) |
893 (t | 898 (t |
894 (lambda (&ignore args) (error "No usable browser found")))) | 899 (lambda (&ignore args) (error "No usable browser found")))) |
895 url args)) | 900 url args)) |
896 | 901 |
897 ;;;###autoload | 902 ;;;###autoload |
898 (defun browse-url-netscape (url &optional new-window) | 903 (defun browse-url-netscape (url &optional new-window) |
899 "Ask the Netscape WWW browser to load URL. | 904 "Ask the Netscape WWW browser to load URL. |
900 Default to the URL around or before point. The strings in variable | 905 Default to the URL around or before point. The strings in variable |
952 (interactive) | 957 (interactive) |
953 ;; Backwards incompatibility reported by | 958 ;; Backwards incompatibility reported by |
954 ;; <peter.kruse@psychologie.uni-regensburg.de>. | 959 ;; <peter.kruse@psychologie.uni-regensburg.de>. |
955 (browse-url-netscape-send (if (>= browse-url-netscape-version 4) | 960 (browse-url-netscape-send (if (>= browse-url-netscape-version 4) |
956 "xfeDoCommand(reload)" | 961 "xfeDoCommand(reload)" |
957 "reload"))) | 962 "reload"))) |
958 | 963 |
959 (defun browse-url-netscape-send (command) | 964 (defun browse-url-netscape-send (command) |
960 "Send a remote control command to Netscape." | 965 "Send a remote control command to Netscape." |
961 (let* ((process-environment (browse-url-process-environment))) | 966 (let* ((process-environment (browse-url-process-environment))) |
962 (apply 'start-process "netscape" nil | 967 (apply 'start-process "netscape" nil |
1197 nil | 1202 nil |
1198 browse-url-gnome-moz-program | 1203 browse-url-gnome-moz-program |
1199 (append | 1204 (append |
1200 browse-url-gnome-moz-arguments | 1205 browse-url-gnome-moz-arguments |
1201 (if (browse-url-maybe-new-window new-window) | 1206 (if (browse-url-maybe-new-window new-window) |
1202 '("--newwin")) | 1207 '("--newwin")) |
1203 (list "--raise" url)))) | 1208 (list "--raise" url)))) |
1204 | 1209 |
1205 ;; --- Mosaic --- | 1210 ;; --- Mosaic --- |
1206 | 1211 |
1207 ;;;###autoload | 1212 ;;;###autoload |
1328 prefix argument reverses the effect of `browse-url-new-window-flag'. | 1333 prefix argument reverses the effect of `browse-url-new-window-flag'. |
1329 | 1334 |
1330 When called non-interactively, optional second argument NEW-WINDOW is | 1335 When called non-interactively, optional second argument NEW-WINDOW is |
1331 used instead of `browse-url-new-window-flag'." | 1336 used instead of `browse-url-new-window-flag'." |
1332 (interactive (browse-url-interactive-arg "W3 URL: ")) | 1337 (interactive (browse-url-interactive-arg "W3 URL: ")) |
1333 (require 'w3) ; w3-fetch-other-window not autoloaded | 1338 (require 'w3) ; w3-fetch-other-window not autoloaded |
1334 (if (browse-url-maybe-new-window new-window) | 1339 (if (browse-url-maybe-new-window new-window) |
1335 (w3-fetch-other-window url) | 1340 (w3-fetch-other-window url) |
1336 (w3-fetch url))) | 1341 (w3-fetch url))) |
1337 | 1342 |
1338 ;;;###autoload | 1343 ;;;###autoload |
1340 ;; new-window ignored | 1345 ;; new-window ignored |
1341 "Ask another Emacs running gnuserv to load the URL using the W3 browser. | 1346 "Ask another Emacs running gnuserv to load the URL using the W3 browser. |
1342 The `browse-url-gnudoit-program' program is used with options given by | 1347 The `browse-url-gnudoit-program' program is used with options given by |
1343 `browse-url-gnudoit-args'. Default to the URL around or before point." | 1348 `browse-url-gnudoit-args'. Default to the URL around or before point." |
1344 (interactive (browse-url-interactive-arg "W3 URL: ")) | 1349 (interactive (browse-url-interactive-arg "W3 URL: ")) |
1345 (apply 'start-process (concat "gnudoit:" url) nil | 1350 (apply 'start-process (concat "gnudoit:" url) nil |
1346 browse-url-gnudoit-program | 1351 browse-url-gnudoit-program |
1347 (append browse-url-gnudoit-args | 1352 (append browse-url-gnudoit-args |
1348 (list (concat "(w3-fetch \"" url "\")") | 1353 (list (concat "(w3-fetch \"" url "\")") |
1349 "(raise-frame)")))) | 1354 "(raise-frame)")))) |
1350 | 1355 |
1351 ;; --- Lynx in an xterm --- | 1356 ;; --- Lynx in an xterm --- |
1352 | 1357 |
1353 ;;;###autoload | 1358 ;;;###autoload |
1354 (defun browse-url-lynx-xterm (url &optional new-window) | 1359 (defun browse-url-lynx-xterm (url &optional new-window) |
1357 Default to the URL around or before point. A new Lynx process is run | 1362 Default to the URL around or before point. A new Lynx process is run |
1358 in an Xterm window using the Xterm program named by `browse-url-xterm-program' | 1363 in an Xterm window using the Xterm program named by `browse-url-xterm-program' |
1359 with possible additional arguments `browse-url-xterm-args'." | 1364 with possible additional arguments `browse-url-xterm-args'." |
1360 (interactive (browse-url-interactive-arg "Lynx URL: ")) | 1365 (interactive (browse-url-interactive-arg "Lynx URL: ")) |
1361 (apply #'start-process `(,(concat "lynx" url) nil ,browse-url-xterm-program | 1366 (apply #'start-process `(,(concat "lynx" url) nil ,browse-url-xterm-program |
1362 ,@browse-url-xterm-args "-e" "lynx" | 1367 ,@browse-url-xterm-args "-e" "lynx" |
1363 ,url))) | 1368 ,url))) |
1364 | 1369 |
1365 ;; --- Lynx in an Emacs "term" window --- | 1370 ;; --- Lynx in an Emacs "term" window --- |
1366 | 1371 |
1367 ;;;###autoload | 1372 ;;;###autoload |
1368 (defun browse-url-lynx-emacs (url &optional new-buffer) | 1373 (defun browse-url-lynx-emacs (url &optional new-buffer) |
1376 reverses the effect of `browse-url-new-window-flag'. | 1381 reverses the effect of `browse-url-new-window-flag'. |
1377 | 1382 |
1378 When called non-interactively, optional second argument NEW-WINDOW is | 1383 When called non-interactively, optional second argument NEW-WINDOW is |
1379 used instead of `browse-url-new-window-flag'." | 1384 used instead of `browse-url-new-window-flag'." |
1380 (interactive (browse-url-interactive-arg "Lynx URL: ")) | 1385 (interactive (browse-url-interactive-arg "Lynx URL: ")) |
1381 (let* ((system-uses-terminfo t) ; Lynx uses terminfo | 1386 (let* ((system-uses-terminfo t) ; Lynx uses terminfo |
1382 ;; (term-term-name "vt100") ; ?? | 1387 ;; (term-term-name "vt100") ; ?? |
1383 (buf (get-buffer "*lynx*")) | 1388 (buf (get-buffer "*lynx*")) |
1384 (proc (and buf (get-buffer-process buf))) | 1389 (proc (and buf (get-buffer-process buf))) |
1385 (n browse-url-lynx-input-attempts)) | 1390 (n browse-url-lynx-input-attempts)) |
1386 (if (and (browse-url-maybe-new-window new-buffer) buf) | 1391 (if (and (browse-url-maybe-new-window new-buffer) buf) |
1417 (if (eq (following-char) ?_) | 1422 (if (eq (following-char) ?_) |
1418 (cond ((eq browse-url-lynx-input-field 'warn) | 1423 (cond ((eq browse-url-lynx-input-field 'warn) |
1419 (error "Please move out of the input field first")) | 1424 (error "Please move out of the input field first")) |
1420 ((eq browse-url-lynx-input-field 'avoid) | 1425 ((eq browse-url-lynx-input-field 'avoid) |
1421 (while (and (eq (following-char) ?_) (> n 0)) | 1426 (while (and (eq (following-char) ?_) (> n 0)) |
1422 (term-send-down) ; down arrow | 1427 (term-send-down) ; down arrow |
1423 (sit-for browse-url-lynx-input-delay)) | 1428 (sit-for browse-url-lynx-input-delay)) |
1424 (if (eq (following-char) ?_) | 1429 (if (eq (following-char) ?_) |
1425 (error "Cannot move out of the input field, sorry"))))) | 1430 (error "Cannot move out of the input field, sorry"))))) |
1426 (term-send-string proc (concat "g" ; goto | 1431 (term-send-string proc (concat "g" ; goto |
1427 "\C-u" ; kill default url | 1432 "\C-u" ; kill default url |
1428 url | 1433 url |
1429 "\r"))))) | 1434 "\r"))))) |
1430 | 1435 |
1431 ;; --- MMM --- | 1436 ;; --- MMM --- |
1496 browser is started up in a new process with possible additional arguments | 1501 browser is started up in a new process with possible additional arguments |
1497 `browse-url-generic-args'. This is appropriate for browsers which | 1502 `browse-url-generic-args'. This is appropriate for browsers which |
1498 don't offer a form of remote control." | 1503 don't offer a form of remote control." |
1499 (interactive (browse-url-interactive-arg "URL: ")) | 1504 (interactive (browse-url-interactive-arg "URL: ")) |
1500 (if (not browse-url-generic-program) | 1505 (if (not browse-url-generic-program) |
1501 (error "No browser defined (`browse-url-generic-program')")) | 1506 (error "No browser defined (`browse-url-generic-program')")) |
1502 (apply 'call-process browse-url-generic-program nil | 1507 (apply 'call-process browse-url-generic-program nil |
1503 0 nil | 1508 0 nil |
1504 (append browse-url-generic-args (list url)))) | 1509 (append browse-url-generic-args (list url)))) |
1505 | 1510 |
1506 ;;;###autoload | 1511 ;;;###autoload |
1508 "Ask the KDE WWW browser to load URL. | 1513 "Ask the KDE WWW browser to load URL. |
1509 Default to the URL around or before point." | 1514 Default to the URL around or before point." |
1510 (interactive (browse-url-interactive-arg "KDE URL: ")) | 1515 (interactive (browse-url-interactive-arg "KDE URL: ")) |
1511 (message "Sending URL to KDE...") | 1516 (message "Sending URL to KDE...") |
1512 (apply #'start-process (concat "KDE " url) nil browse-url-kde-program | 1517 (apply #'start-process (concat "KDE " url) nil browse-url-kde-program |
1513 (append browse-url-kde-args (list url)))) | 1518 (append browse-url-kde-args (list url)))) |
1514 | 1519 |
1515 ;;;###autoload | 1520 ;;;###autoload |
1516 (defun browse-url-elinks (url) | 1521 (defun browse-url-elinks (url) |
1517 "Ask the Elinks WWW browser to load URL. | 1522 "Ask the Elinks WWW browser to load URL. |
1518 Default to the URL around the point. | 1523 Default to the URL around the point. |
1524 from `elinks-browse-url-wrapper'." | 1529 from `elinks-browse-url-wrapper'." |
1525 (interactive (browse-url-interactive-arg "URL: ")) | 1530 (interactive (browse-url-interactive-arg "URL: ")) |
1526 (setq url (browse-url-encode-url url)) | 1531 (setq url (browse-url-encode-url url)) |
1527 (let ((process-environment (browse-url-process-environment)) | 1532 (let ((process-environment (browse-url-process-environment)) |
1528 (elinks-ping-process (start-process "elinks-ping" nil | 1533 (elinks-ping-process (start-process "elinks-ping" nil |
1529 "elinks" "-remote" "ping()"))) | 1534 "elinks" "-remote" "ping()"))) |
1530 (set-process-sentinel elinks-ping-process | 1535 (set-process-sentinel elinks-ping-process |
1531 `(lambda (process change) | 1536 `(lambda (process change) |
1532 (browse-url-elinks-sentinel process ,url))))) | 1537 (browse-url-elinks-sentinel process ,url))))) |
1533 | 1538 |
1534 (defun browse-url-elinks-sentinel (process url) | 1539 (defun browse-url-elinks-sentinel (process url) |
1536 (let ((exit-status (process-exit-status process)) | 1541 (let ((exit-status (process-exit-status process)) |
1537 (process-environment (browse-url-process-environment))) | 1542 (process-environment (browse-url-process-environment))) |
1538 ;; Try to determine if an instance is running or if we have to | 1543 ;; Try to determine if an instance is running or if we have to |
1539 ;; create a new one. | 1544 ;; create a new one. |
1540 (case exit-status | 1545 (case exit-status |
1541 (5 | 1546 (5 |
1542 ;; No instance, start a new one. | 1547 ;; No instance, start a new one. |
1543 (apply #'start-process | 1548 (apply #'start-process |
1544 (append (list (concat "elinks:" url) nil) | 1549 (append (list (concat "elinks:" url) nil) |
1545 browse-url-elinks-wrapper | 1550 browse-url-elinks-wrapper |
1546 (list "elinks" url)))) | 1551 (list "elinks" url)))) |
1547 (0 | 1552 (0 |
1548 ;; Found an instance, open URL in new tab. | 1553 ;; Found an instance, open URL in new tab. |
1549 (start-process (concat "elinks:" url) nil | 1554 (start-process (concat "elinks:" url) nil |
1550 "elinks" "-remote" | 1555 "elinks" "-remote" |
1551 (concat "openURL(\"" url "\",new-tab)"))) | 1556 (concat "openURL(\"" url "\",new-tab)"))) |
1552 (otherwise | 1557 (otherwise |
1553 (error "Undefined exit-code of process `elinks'."))))) | 1558 (error "Undefined exit-code of process `elinks'"))))) |
1554 | 1559 |
1555 (provide 'browse-url) | 1560 (provide 'browse-url) |
1556 | 1561 |
1557 ;; arch-tag: d2079573-5c06-4097-9598-f550fba19430 | 1562 ;; arch-tag: d2079573-5c06-4097-9598-f550fba19430 |
1558 ;;; browse-url.el ends here | 1563 ;;; browse-url.el ends here |