Commit 28630e9f authored by David Byers's avatar David Byers
Browse files

Fixed bug 678.

Detailed changes:
> 	Fix bug 678:
> 	* vars.el.in (lyskom-text-buttons): Made RFC-compliant URL
> 	specifications "pseudo" URLs, since there may be incomplete URLs
> 	inside brackets and stuff. Added validity check to RFC-compliant
> 	URL specifications, so not anything in <> will pass.
>
> 	* utilities.el (lyskom-is-url): New function.
>
> 	* lyskom-buttons.el (lyskom-button-transform-text): Support match
> 	predicates in lyskom-text-buttons.
> 	(lyskom-button-get-pred): New function.
>
> 	* vars.el.in (lyskom-text-buttons): Added support for URLs
> 	according to Appendix E in RFC2396.
>
parent 329926a6
2003-04-06 David Byers <byers@lysator.liu.se>
Fix bug 678:
* vars.el.in (lyskom-text-buttons): Made RFC-compliant URL
specifications "pseudo" URLs, since there may be incomplete URLs
inside brackets and stuff. Added validity check to RFC-compliant
URL specifications, so not anything in <> will pass.
* utilities.el (lyskom-is-url): New function.
* lyskom-buttons.el (lyskom-button-transform-text): Support match
predicates in lyskom-text-buttons.
(lyskom-button-get-pred): New function.
* vars.el.in (lyskom-text-buttons): Added support for URLs
according to Appendix E in RFC2396.
Cosmetic fix:
* commands1.el (lyskom-list-conf-print): Don't make each line
clickable in its entirety. Just print things normally.
......
......@@ -327,6 +327,30 @@ LINKS is a list of lyskom-text-link objects."
text)))))
(defun lyskom-button-get-arg (el text)
"Get the button argument for button type EL from TEXT according to
the current match-data."
(let ((no (or (elt el 3) 0)))
(substring text (match-beginning no) (match-end no))))
(defun lyskom-button-get-text (el text)
"Get the button text for button type EL from TEXT according to
the current match-data."
(let ((no (or (elt el 2) 0)))
(substring text (match-beginning no) (match-end no))))
(defun lyskom-button-get-face (el)
"Get the button face for button type EL from TEXT according to
the current match-data."
(let ((face (elt el 4)))
(or (and (boundp face) (symbol-value face))
(and (facep face) face))))
(defsubst lyskom-button-get-pred (el)
"Return the match predicate for bitton type EL."
(elt el 5))
(defun lyskom-button-transform-text (text &optional text-stat)
"Add text properties to the string TEXT according to the definition of
lyskom-text-buttons. Returns the modified string."
......@@ -349,76 +373,62 @@ lyskom-text-buttons. Returns the modified string."
(setq el (car blist))
(setq start 0)
(while (string-match (elt el 0) text start)
(add-text-properties
(match-beginning (or (elt el 2) 0))
(match-end (or (elt el 2) 0))
(cond ((and (eq (elt el 1) 'text)
(not lyskom-transforming-external-text))
(lyskom-generate-button 'text
(lyskom-button-get-arg el text)
(lyskom-button-get-text el text)
(lyskom-button-get-face el)))
((eq (elt el 1) 'conf)
(lyskom-generate-button 'conf
(lyskom-button-get-arg el text)
(lyskom-button-get-text el text)
(lyskom-button-get-face el)))
((eq (elt el 1) 'pers)
(lyskom-generate-button 'pers
(lyskom-button-get-arg el text)
(lyskom-button-get-text el text)
(lyskom-button-get-face el)))
((eq (elt el 1) 'url)
(lyskom-generate-button 'url
nil
(lyskom-button-get-text el text)
(lyskom-button-get-face el)))
((eq (elt el 1) 'pseudo-url)
(let ((url (lyskom-fix-pseudo-url
(lyskom-button-get-text el text))))
(lyskom-generate-button 'url
nil
url
(lyskom-button-get-face el))))
((eq (elt el 1) 'info-node)
(lyskom-generate-button 'info-node
(lyskom-button-get-arg el text)
(lyskom-button-get-text el text)
(lyskom-button-get-face el)))
((eq (elt el 1) 'email)
(lyskom-generate-button 'email
nil
(lyskom-button-get-text el text)
(lyskom-button-get-face el)))
(t nil))
text)
(setq start (match-end 0)))
(if (or (null (lyskom-button-get-pred el))
(funcall (lyskom-button-get-pred el)
(lyskom-button-get-text el text)))
(progn
(add-text-properties
(match-beginning (or (elt el 2) 0))
(match-end (or (elt el 2) 0))
(cond ((and (eq (elt el 1) 'text)
(not lyskom-transforming-external-text))
(lyskom-generate-button 'text
(lyskom-button-get-arg el text)
(lyskom-button-get-text el text)
(lyskom-button-get-face el)))
((eq (elt el 1) 'conf)
(lyskom-generate-button 'conf
(lyskom-button-get-arg el text)
(lyskom-button-get-text el text)
(lyskom-button-get-face el)))
((eq (elt el 1) 'pers)
(lyskom-generate-button 'pers
(lyskom-button-get-arg el text)
(lyskom-button-get-text el text)
(lyskom-button-get-face el)))
((eq (elt el 1) 'url)
(lyskom-generate-button 'url
nil
(lyskom-button-get-text el text)
(lyskom-button-get-face el)))
((eq (elt el 1) 'pseudo-url)
(let ((url (lyskom-fix-pseudo-url
(lyskom-button-get-text el text))))
(lyskom-generate-button 'url
nil
url
(lyskom-button-get-face el))))
((eq (elt el 1) 'info-node)
(lyskom-generate-button 'info-node
(lyskom-button-get-arg el text)
(lyskom-button-get-text el text)
(lyskom-button-get-face el)))
((eq (elt el 1) 'email)
(lyskom-generate-button 'email
nil
(lyskom-button-get-text el text)
(lyskom-button-get-face el)))
(t nil))
text)
(setq start (match-end 0)))
(setq start (1+ (match-beginning 0)))))
(setq blist (cdr blist))))
text)
(defun lyskom-button-get-arg (el text)
"Get the button argument for button type EL from TEXT according to
the current match-data."
(let ((no (or (elt el 3) 0)))
(substring text (match-beginning no) (match-end no))))
(defun lyskom-button-get-text (el text)
"Get the button text for button type EL from TEXT according to
the current match-data."
(let ((no (or (elt el 2) 0)))
(substring text (match-beginning no) (match-end no))))
(defun lyskom-button-get-face (el)
"Get the button face for button type EL from TEXT according to
the current match-data."
(let ((face (elt el 4)))
(or (and (boundp face) (symbol-value face))
(and (facep face) face))))
(defun lyskom-get-button-hint (hints)
"Get the hint to be used right now (if any) from HINTS"
......
......@@ -1919,3 +1919,12 @@ has the bug in that algorithm fixed)."
;;; '(face test-2)
;;; '(face test-default))))))
;;;
(defun lyskom-is-url (text)
"Return non-nil if TEXT can be interpreted as an URL.
Any whitespace and newlines in TEXT will be ignored."
(save-match-data
(let ((text (replace-in-string text "\\s-+" "")))
(or (string-match "^\\(file://\\|ftp://\\|gopher://\\|http://\\|https://\\|news:\\|wais://\\|mailto:\\|telnet:\\)[^\t \012\014\"<>|\\]*[^][\t \012\014\"<>|.,!(){}?'`:;]$" text)
(string-match "^\\(www\\|ftp\\|home\\)\\.[^\t \012\014\"<>|\\]*[^][\t \012\014\"<>|.,!(){}?'`:;]$" text)))))
......@@ -1809,13 +1809,16 @@ conference and person buttons are not expected.")
;; URLs
("<URL:\\s-*\\([^>]*\\)\\s-*>"
pseudo-url 1 1 kom-url-face lyskom-is-url)
("<\\s-*\\([^>]*\\)\\s-*>"
pseudo-url 1 1 kom-url-face lyskom-is-url)
("\\b\\(www\\|ftp\\|home\\)\\.[^\t \012\014\"<>|\\]*[^][\t \012\014\"<>|.,!(){}?'`:;]"
pseudo-url 0 nil kom-url-face)
("\\(file://\\|ftp://\\|gopher://\\|http://\\|https://\\|news:\\|wais://\\|mailto:\\|telnet:\\)[^\t \012\014\"<>|\\]*[^][\t \012\014\"<>|.,!(){}?'`:;]"
url 0 nil kom-url-face)
("<URL:\\s-*\\([^>]*\\)\\s-*>"
url 1 1 kom-url-face)
;; JySKom enhancements
......@@ -1832,13 +1835,17 @@ conference and person buttons are not expected.")
info-node 1 3 kom-url-face)
)
"List of buttons to install in the text mass of LysKOM objects. Each element is
a list consisting of REGEXP TYPE BUTTON-MATCH BUTTON-ARG-MATCH FACE.
"List of buttons to install in the text mass of LysKOM objects. Each
element is a list consisting of REGEXP TYPE BUTTON-MATCH BUTTON-ARG-MATCH
FACE &optional PRED.
REGEXP is the regexp to look for in the text.
TYPE is the button type. Valid button types are defined in lyskom-button-actions.
BUTTON-MATCH is the number of the parenthesized expression that is the actual button.
BUTTON-ARG-MATCH is the number of the expression to be used as the button argument.
FACE is the text face to apply to the button, or nil to use the default face.")
FACE is the text face to apply to the button, or nil to use the default face.
If PRED is given, it is a function that will be passed the matched string; if
it returns non-nil, the match is considered valid.")
(def-kom-var kom-url-viewer-preferences '("emacs"
"windows"
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment