Mercurial > hg > xemacs-beta

comparison lisp/hyperbole/hpath.el @ 36:c53a95d3c46d r19-15b101

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b101
author cvs
date Mon, 13 Aug 2007 08:53:38 +0200
parents 4103f0995bd7
children 1a767b41a199
comparison
equal deleted inserted replaced
35:279432d5c479 36:c53a95d3c46d
7 ;; 7 ;;
8 ;; AUTHOR: Bob Weiner 8 ;; AUTHOR: Bob Weiner
9 ;; ORG: InfoDock Associates 9 ;; ORG: InfoDock Associates
10 ;; 10 ;;
11 ;; ORIG-DATE: 1-Nov-91 at 00:44:23 11 ;; ORIG-DATE: 1-Nov-91 at 00:44:23
12 ;; LAST-MOD: 16-Feb-97 at 02:34:35 by Bob Weiner 12 ;; LAST-MOD: 9-Mar-97 at 01:38:33 by Bob Weiner
13 13
14 ;;; ************************************************************************ 14 ;;; ************************************************************************
15 ;;; Public variables 15 ;;; Public variables
16 ;;; ************************************************************************ 16 ;;; ************************************************************************
17 17
550 1 = optional `URL:' literal 550 1 = optional `URL:' literal
551 2 = access protocol 551 2 = access protocol
552 4 = optional username 552 4 = optional username
553 4 = host and domain to connect to 553 4 = host and domain to connect to
554 5 = optional port number to use 554 5 = optional port number to use
555 6 = pathname to access." 555 6 = optional pathname to access."
556 ;; WWW URL format: [URL:]<protocol>:/[<user>@]<domain>[:<port>]/<path> 556 ;; WWW URL format: [URL:]<protocol>:/[<user>@]<domain>[:<port>][/<path>]
557 ;; or [URL:]<protocol>://[<user>@]<domain>[:<port>]<path> 557 ;; or [URL:]<protocol>://[<user>@]<domain>[:<port>][<path>]
558 ;; Avoid [a-z]:/path patterns since these may be disk paths on OS/2, DOS or 558 ;; Avoid [a-z]:/path patterns since these may be disk paths on OS/2, DOS or
559 ;; Windows. 559 ;; Windows.
560 (if (looking-at "\\(URL:\\)?\\([a-zA-Z][a-zA-Z]+\\)://?\\([^@/: \t\n\^M]+@\\)?\\([^/:@ \t\n\^M\"`']+\\)\\(:[0-9]+\\)?\\([/~][^]@ \t\n\^M\"`'\)\}>]*\\)?") 560 (if (looking-at "\\(URL:\\)?\\([a-zA-Z][a-zA-Z]+\\)://?\\([^@/: \t\n\^M]+@\\)?\\([^/:@ \t\n\^M\"`']+\\)\\(:[0-9]+\\)?\\([/~][^]@ \t\n\^M\"`'\)\}>]*\\)?")
561 (save-excursion 561 (save-excursion
562 (goto-char (match-end 6)) 562 (goto-char (match-end 0))
563 (skip-chars-backward ".?#!*()") 563 (skip-chars-backward ".?#!*()")
564 (buffer-substring (match-beginning 2) (point))))) 564 (buffer-substring (match-beginning 2) (point)))))
565 565
566 (defun hpath:url-p (obj) 566 (defun hpath:url-p (obj)
567 "Return t if OBJ is a world-wide-web universal resource locator (url) string, else nil. 567 "Return t if OBJ is a world-wide-web universal resource locator (url) string, else nil.
569 1 = optional `URL:' literal 569 1 = optional `URL:' literal
570 2 = access protocol 570 2 = access protocol
571 3 = optional username 571 3 = optional username
572 4 = host and domain to connect to 572 4 = host and domain to connect to
573 5 = optional port number to use 573 5 = optional port number to use
574 6 = pathname to access." 574 6 = optional pathname to access."
575 ;; WWW URL format: [URL:]<protocol>:/[<user>@]<domain>[:<port>]/<path> 575 ;; WWW URL format: [URL:]<protocol>:/[<user>@]<domain>[:<port>][/<path>]
576 ;; or [URL:]<protocol>://[<user>@]<domain>[:<port>]<path> 576 ;; or [URL:]<protocol>://[<user>@]<domain>[:<port>][<path>]
577 ;; Avoid [a-z]:/path patterns since these may be disk paths on OS/2, DOS or 577 ;; Avoid [a-z]:/path patterns since these may be disk paths on OS/2, DOS or
578 ;; Windows. 578 ;; Windows.
579 (and (stringp obj) 579 (and (stringp obj)
580 (string-match "\\`<?\\(URL:\\)?\\([a-zA-Z][a-zA-Z]+\\)://?\\([^@/: \t\n\^M]+@\\)?\\([^/:@ \t\n\^M\"`']+\\)\\(:[0-9]+\\)?\\([/~][^]@ \t\n\^M\"`'\)\}>]*\\)?>?\\'" 580 (string-match "\\`<?\\(URL:\\)?\\([a-zA-Z][a-zA-Z]+\\)://?\\([^@/: \t\n\^M]+@\\)?\\([^/:@ \t\n\^M\"`']+\\)\\(:[0-9]+\\)?\\([/~][^]@ \t\n\^M\"`'\)\}>]*\\)?>?\\'"
581 obj) 581 obj)
588 (save-excursion 588 (save-excursion
589 (skip-chars-backward "^[ \t\n\"`'\(\{<") 589 (skip-chars-backward "^[ \t\n\"`'\(\{<")
590 (cond ((not include-start-and-end-p) 590 (cond ((not include-start-and-end-p)
591 (hpath:url-at-p)) 591 (hpath:url-at-p))
592 ((hpath:url-at-p) 592 ((hpath:url-at-p)
593 (list (buffer-substring (match-beginning 2) (match-end 6)) 593 (list (buffer-substring (match-beginning 2) (match-end 0))
594 (match-beginning 2) 594 (match-beginning 2)
595 (match-end 6)))))) 595 (match-end 0))))))
596 596
597 (defun hpath:www-p (path) 597 (defun hpath:www-p (path)
598 "Returns non-nil iff PATH is a world-wide-web link reference." 598 "Returns non-nil iff PATH is a world-wide-web link reference."
599 (and (stringp path) (hpath:url-p path) path)) 599 (and (stringp path) (hpath:url-p path) path))
600 600