diff options
| author | Michaël Cadilhac | 2007-09-17 15:59:55 +0000 |
|---|---|---|
| committer | Michaël Cadilhac | 2007-09-17 15:59:55 +0000 |
| commit | 6eddc3bb42efc56044ed3abb5b24b40810b0b99c (patch) | |
| tree | 4efa50dfa0d5957a63ebdb7b6c2d323c86f7682d | |
| parent | 879ffad91329a32d64bcbf00eb98eb23173d1199 (diff) | |
| download | emacs-6eddc3bb42efc56044ed3abb5b24b40810b0b99c.tar.gz emacs-6eddc3bb42efc56044ed3abb5b24b40810b0b99c.zip | |
(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.
| -rw-r--r-- | lisp/ChangeLog | 9 | ||||
| -rw-r--r-- | lisp/net/browse-url.el | 113 |
2 files changed, 68 insertions, 54 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c2b1e6be276..428920aca19 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,12 @@ | |||
| 1 | 2007-09-17 Micha,Ak(Bl Cadilhac <michael@cadilhac.name> | ||
| 2 | |||
| 3 | * net/browse-url.el (browse-url-url-encode-chars): New function. | ||
| 4 | URL-encode some chars in a string. | ||
| 5 | (browse-url-encode-url): Rewrite using the previous function. | ||
| 6 | (browse-url-file-url): Use `browse-url-url-encode-chars'. | ||
| 7 | (browse-url-elinks-sentinel): Fix typo. | ||
| 8 | (browse-url-new-window-flag): Doc change. | ||
| 9 | |||
| 1 | 2007-09-17 Glenn Morris <rgm@gnu.org> | 10 | 2007-09-17 Glenn Morris <rgm@gnu.org> |
| 2 | 11 | ||
| 3 | * textmodes/tex-mode.el (tex-compilation-parse-errors): Prefer the | 12 | * textmodes/tex-mode.el (tex-compilation-parse-errors): Prefer the |
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 936ca2d4222..33dfb327864 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el | |||
| @@ -72,7 +72,7 @@ | |||
| 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. |
| @@ -430,7 +430,7 @@ window." | |||
| 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." |
| @@ -619,14 +619,12 @@ down (this *won't* always work)." | |||
| 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))) |
| @@ -634,6 +632,13 @@ Otherwise, the confusing characters are [*\"()',=;?% ]." | |||
| 634 | s (1+ s))) | 632 | s (1+ s))) |
| 635 | encoded-url)) | 633 | encoded-url)) |
| 636 | 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 "[,)$]")) | ||
| 641 | |||
| 637 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 642 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 638 | ;; URL input | 643 | ;; URL input |
| 639 | 644 | ||
| @@ -706,7 +711,7 @@ Use variable `browse-url-filename-alist' to map filenames to URLs." | |||
| 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)))) |
| @@ -878,21 +883,21 @@ 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) |
| @@ -954,7 +959,7 @@ How depends on `browse-url-netscape-version'." | |||
| 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." |
| @@ -1199,7 +1204,7 @@ used instead of `browse-url-new-window-flag'." | |||
| 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 --- |
| @@ -1330,7 +1335,7 @@ prefix argument reverses the effect of `browse-url-new-window-flag'. | |||
| 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))) |
| @@ -1342,11 +1347,11 @@ used instead of `browse-url-new-window-flag'." | |||
| 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 | ||
| @@ -1359,8 +1364,8 @@ 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 | ||
| @@ -1378,7 +1383,7 @@ reverses the effect of `browse-url-new-window-flag'. | |||
| 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))) |
| @@ -1419,11 +1424,11 @@ used instead of `browse-url-new-window-flag'." | |||
| 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"))))) |
| @@ -1498,7 +1503,7 @@ browser is started up in a new process with possible additional arguments | |||
| 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)))) |
| @@ -1510,7 +1515,7 @@ 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) |
| @@ -1526,7 +1531,7 @@ from `elinks-browse-url-wrapper'." | |||
| 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))))) |
| @@ -1538,19 +1543,19 @@ from `elinks-browse-url-wrapper'." | |||
| 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 | ||