Mercurial > emacs
comparison lisp/net/goto-addr.el @ 94318:76f3f9a141a5
Tom Tromey <tromey at redhat.com>
(goto-address-unfontify): New function.
(goto-address-fontify): Use it. Respect goto-address-prog-mode.
(goto-address-fontify-region, goto-address-mode)
(goto-address-prog-mode): New functions.
| author | Glenn Morris <rgm@gnu.org> |
|---|---|
| date | Thu, 24 Apr 2008 05:48:08 +0000 |
| parents | 6888fd3398e8 |
| children | 693b7934455a |
comparison
equal
deleted
inserted
replaced
| 94317:8f25e59015ea | 94318:76f3f9a141a5 |
|---|---|
| 149 (defcustom goto-address-mail-mouse-face 'secondary-selection | 149 (defcustom goto-address-mail-mouse-face 'secondary-selection |
| 150 "Face to use for e-mail addresses when the mouse is on them." | 150 "Face to use for e-mail addresses when the mouse is on them." |
| 151 :type 'face | 151 :type 'face |
| 152 :group 'goto-address) | 152 :group 'goto-address) |
| 153 | 153 |
| 154 (defun goto-address-unfontify (start end) | |
| 155 "Remove `goto-address' fontification from the given region." | |
| 156 (dolist (overlay (overlays-in start end)) | |
| 157 (if (overlay-get overlay 'goto-address) | |
| 158 (delete-overlay overlay)))) | |
| 159 | |
| 154 (defun goto-address-fontify () | 160 (defun goto-address-fontify () |
| 155 "Fontify the URLs and e-mail addresses in the current buffer. | 161 "Fontify the URLs and e-mail addresses in the current buffer. |
| 156 This function implements `goto-address-highlight-p' | 162 This function implements `goto-address-highlight-p' |
| 157 and `goto-address-fontify-p'." | 163 and `goto-address-fontify-p'." |
| 158 ;; Clean up from any previous go. | 164 ;; Clean up from any previous go. |
| 159 (dolist (overlay (overlays-in (point-min) (point-max))) | 165 (goto-address-unfontify (point-min) (point-max)) |
| 160 (if (overlay-get overlay 'goto-address) | |
| 161 (delete-overlay overlay))) | |
| 162 (save-excursion | 166 (save-excursion |
| 163 (let ((inhibit-point-motion-hooks t)) | 167 (let ((inhibit-point-motion-hooks t)) |
| 164 (goto-char (point-min)) | 168 (goto-char (point-min)) |
| 165 (if (or (eq t goto-address-fontify-maximum-size) | 169 (when (or (eq t goto-address-fontify-maximum-size) |
| 166 (< (- (point-max) (point)) goto-address-fontify-maximum-size)) | 170 (< (- (point-max) (point)) goto-address-fontify-maximum-size)) |
| 167 (progn | 171 (while (re-search-forward goto-address-url-regexp nil t) |
| 168 (while (re-search-forward goto-address-url-regexp nil t) | 172 (let* ((s (match-beginning 0)) |
| 169 (let* ((s (match-beginning 0)) | 173 (e (match-end 0)) |
| 170 (e (match-end 0)) | 174 this-overlay) |
| 171 (this-overlay (make-overlay s e))) | 175 (when (or (not goto-address-prog-mode) |
| 172 (and goto-address-fontify-p | 176 ;; This tests for both comment and string |
| 173 (overlay-put this-overlay 'face goto-address-url-face)) | 177 ;; syntax. |
| 174 (overlay-put this-overlay 'evaporate t) | 178 (nth 8 (syntax-ppss))) |
| 175 (overlay-put this-overlay | 179 (setq this-overlay (make-overlay s e)) |
| 176 'mouse-face goto-address-url-mouse-face) | 180 (and goto-address-fontify-p |
| 177 (overlay-put this-overlay 'follow-link t) | 181 (overlay-put this-overlay 'face goto-address-url-face)) |
| 178 (overlay-put this-overlay | 182 (overlay-put this-overlay 'evaporate t) |
| 179 'help-echo "mouse-2, C-c RET: follow URL") | 183 (overlay-put this-overlay |
| 180 (overlay-put this-overlay | 184 'mouse-face goto-address-url-mouse-face) |
| 181 'keymap goto-address-highlight-keymap) | 185 (overlay-put this-overlay 'follow-link t) |
| 182 (overlay-put this-overlay 'goto-address t))) | 186 (overlay-put this-overlay |
| 183 (goto-char (point-min)) | 187 'help-echo "mouse-2, C-c RET: follow URL") |
| 184 (while (re-search-forward goto-address-mail-regexp nil t) | 188 (overlay-put this-overlay |
| 185 (let* ((s (match-beginning 0)) | 189 'keymap goto-address-highlight-keymap) |
| 186 (e (match-end 0)) | 190 (overlay-put this-overlay 'goto-address t)))) |
| 187 (this-overlay (make-overlay s e))) | 191 (goto-char (point-min)) |
| 188 (and goto-address-fontify-p | 192 (while (re-search-forward goto-address-mail-regexp nil t) |
| 189 (overlay-put this-overlay 'face goto-address-mail-face)) | 193 (let* ((s (match-beginning 0)) |
| 190 (overlay-put this-overlay 'evaporate t) | 194 (e (match-end 0)) |
| 191 (overlay-put this-overlay 'mouse-face | 195 this-overlay) |
| 192 goto-address-mail-mouse-face) | 196 (when (or (not goto-address-prog-mode) |
| 193 (overlay-put this-overlay 'follow-link t) | 197 ;; This tests for both comment and string |
| 194 (overlay-put this-overlay | 198 ;; syntax. |
| 195 'help-echo "mouse-2, C-c RET: mail this address") | 199 (nth 8 (syntax-ppss))) |
| 196 (overlay-put this-overlay | 200 (setq this-overlay (make-overlay s e)) |
| 197 'keymap goto-address-highlight-keymap) | 201 (and goto-address-fontify-p |
| 198 (overlay-put this-overlay 'goto-address t)))))))) | 202 (overlay-put this-overlay 'face goto-address-mail-face)) |
| 203 (overlay-put this-overlay 'evaporate t) | |
| 204 (overlay-put this-overlay 'mouse-face | |
| 205 goto-address-mail-mouse-face) | |
| 206 (overlay-put this-overlay 'follow-link t) | |
| 207 (overlay-put this-overlay | |
| 208 'help-echo "mouse-2, C-c RET: mail this address") | |
| 209 (overlay-put this-overlay | |
| 210 'keymap goto-address-highlight-keymap) | |
| 211 (overlay-put this-overlay 'goto-address t)))))))) | |
| 212 | |
| 213 (defun goto-address-fontify-region (start end) | |
| 214 "Fontify URLs and e-mail addresses in the given region." | |
| 215 (save-excursion | |
| 216 (save-restriction | |
| 217 (let ((beg-line (progn (goto-char start) (line-beginning-position))) | |
| 218 (end-line (progn (goto-char end) (line-end-position)))) | |
| 219 (narrow-to-region beg-line end-line) | |
| 220 (goto-address-fontify))))) | |
| 199 | 221 |
| 200 ;; code to find and goto addresses; much of this has been blatantly | 222 ;; code to find and goto addresses; much of this has been blatantly |
| 201 ;; snarfed from browse-url.el | 223 ;; snarfed from browse-url.el |
| 202 | 224 |
| 203 ;;;###autoload | 225 ;;;###autoload |
| 250 (interactive) | 272 (interactive) |
| 251 (if goto-address-highlight-p | 273 (if goto-address-highlight-p |
| 252 (goto-address-fontify))) | 274 (goto-address-fontify))) |
| 253 ;;;###autoload(put 'goto-address 'safe-local-eval-function t) | 275 ;;;###autoload(put 'goto-address 'safe-local-eval-function t) |
| 254 | 276 |
| 277 ;;;###autoload | |
| 278 (define-minor-mode goto-address-mode | |
| 279 "Minor mode to buttonize URLs and e-mail addresses in the current buffer." | |
| 280 nil | |
| 281 "" | |
| 282 nil | |
| 283 (if goto-address-mode | |
| 284 (jit-lock-register #'goto-address-fontify-region) | |
| 285 (jit-lock-unregister #'goto-address-fontify-region) | |
| 286 (save-restriction | |
| 287 (widen) | |
| 288 (goto-address-unfontify (point-min) (point-max))))) | |
| 289 | |
| 290 ;;;###autoload | |
| 291 (define-minor-mode goto-address-prog-mode | |
| 292 "Turn on `goto-address-mode', but only in comments and strings." | |
| 293 nil | |
| 294 "" | |
| 295 nil | |
| 296 (if goto-address-prog-mode | |
| 297 (jit-lock-register #'goto-address-fontify-region) | |
| 298 (jit-lock-unregister #'goto-address-fontify-region) | |
| 299 (save-restriction | |
| 300 (widen) | |
| 301 (goto-address-unfontify (point-min) (point-max))))) | |
| 302 | |
| 255 (provide 'goto-addr) | 303 (provide 'goto-addr) |
| 256 | 304 |
| 257 ;; arch-tag: ca47c505-5661-425d-a471-62bc6e75cf0a | 305 ;; arch-tag: ca47c505-5661-425d-a471-62bc6e75cf0a |
| 258 ;;; goto-addr.el ends here | 306 ;;; goto-addr.el ends here |