X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/eba8dcd060689675c9778392d4ada66395d21a3e..ca2ebe63eba27e234394e9c5c20229dcdce87b33:/lisp/goto-addr.el

diff --git a/lisp/goto-addr.el b/lisp/goto-addr.el
index 30f7eca813..7a4026158a 100644
--- a/lisp/goto-addr.el
+++ b/lisp/goto-addr.el
@@ -72,16 +72,28 @@
 
 (require 'browse-url)
 
+(defgroup goto-address nil
+  "Click to browse URL or to send to e-mail address."
+  :group 'mouse
+  :group 'hypermedia)
+
+
 ;;; I don't expect users to want fontify'ing without highlighting.
-(defvar goto-address-fontify-p t
+(defcustom goto-address-fontify-p t
   "*If t, URL's and e-mail addresses in buffer are fontified.
-But only if `goto-address-highlight-p' is also non-nil.")
+But only if `goto-address-highlight-p' is also non-nil."
+  :type 'boolean
+  :group 'goto-address)
 
-(defvar goto-address-highlight-p t
-  "*If t, URL's and e-mail addresses in buffer are highlighted.")
+(defcustom goto-address-highlight-p t
+  "*If t, URL's and e-mail addresses in buffer are highlighted."
+  :type 'boolean
+  :group 'goto-address)
 
-(defvar goto-address-fontify-maximum-size 30000
-  "*Maximum size of file in which to fontify and/or highlight URL's.")
+(defcustom goto-address-fontify-maximum-size 30000
+  "*Maximum size of file in which to fontify and/or highlight URL's."
+  :type 'integer
+  :group 'goto-address)
 
 (defvar goto-address-mail-regexp
   "[-a-zA-Z0-9._]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+"
@@ -94,11 +106,13 @@ But only if `goto-address-highlight-p' is also non-nil.")
 	  "[-a-zA-Z0-9_=#$@~`%&*+|\\/]")
   "A regular expression probably matching a URL.")
 
-(defvar goto-address-mail-method
+(defcustom goto-address-mail-method
   'goto-address-send-using-mail
   "*Function to compose mail.
 Two pre-made functions are `goto-address-send-using-mail' (sendmail);
-and `goto-address-send-using-mh-e' (MH-E).")
+and `goto-address-send-using-mh-e' (MH-E)."
+  :type 'function
+  :group 'goto-address)
 
 (defvar goto-address-highlight-keymap
   (let ((m (make-sparse-keymap)))
@@ -106,6 +120,26 @@ and `goto-address-send-using-mh-e' (MH-E).")
     m)
   "keymap to hold goto-addr's mouse key defs under highlighted URLs.")
 
+(defcustom goto-address-url-face 'bold
+  "*Face to use for URLs."
+  :type 'face
+  :group 'goto-address)
+
+(defcustom goto-address-url-mouse-face 'highlight
+  "*Face to use for URLs when the mouse is on them."
+  :type 'face
+  :group 'goto-address)
+
+(defcustom goto-address-mail-face 'italic
+  "*Face to use for e-mail addresses."
+  :type 'face
+  :group 'goto-address)
+
+(defcustom goto-address-mail-mouse-face 'secondary-selection
+  "*Face to use for e-mail addresses when the mouse is on them."
+  :type 'face
+  :group 'goto-address)
+
 (defun goto-address-fontify ()
   "Fontify the URL's and e-mail addresses in the current buffer.
 This function implements `goto-address-highlight-p'
@@ -118,26 +152,26 @@ and `goto-address-fontify-p'."
       (if (< (- (point-max) (point)) goto-address-fontify-maximum-size)
 	  (progn
 	    (while (re-search-forward goto-address-url-regexp nil t)
-              (let ((s (match-beginning 0))
-                    (e (match-end 0)))
-		(goto-char e)
+              (let* ((s (match-beginning 0))
+                     (e (match-end 0))
+                     (this-overlay (make-overlay s e)))
 		(and goto-address-fontify-p
-		     (put-text-property s e 'face 'bold))
-		(put-text-property s e 'mouse-face 'highlight)
-		(put-text-property
-		 s e 'local-map goto-address-highlight-keymap)))
+                     (overlay-put this-overlay 'face goto-address-url-face))
+		(overlay-put this-overlay
+                             'mouse-face goto-address-url-mouse-face)
+		(overlay-put this-overlay
+                             'local-map goto-address-highlight-keymap)))
 	    (goto-char (point-min))
 	    (while (re-search-forward goto-address-mail-regexp nil t)
-              (let ((s (match-beginning 0))
-                    (e (match-end 0)))
-		(goto-char (match-end 0))
+              (let* ((s (match-beginning 0))
+                     (e (match-end 0))
+                     (this-overlay (make-overlay s e)))
 		(and goto-address-fontify-p
-		     (put-text-property (match-beginning 0) (match-end 0)
-					'face 'italic))
-		(put-text-property (match-beginning 0) (match-end 0)
-				   'mouse-face 'secondary-selection)
-		(put-text-property
-		 s e 'local-map goto-address-highlight-keymap)))))
+                     (overlay-put this-overlay 'face goto-address-mail-face))
+                (overlay-put this-overlay 'mouse-face
+                             goto-address-mail-mouse-face)
+                (overlay-put this-overlay
+                             'local-map goto-address-highlight-keymap)))))
       (and (buffer-modified-p)
 	   (not modified)
 	   (set-buffer-modified-p nil)))))