Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-art.el @ 24:4103f0995bd7 r19-15b95

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b95
author cvs
date Mon, 13 Aug 2007 08:51:03 +0200
parents 8fc7fe29b841
children 1917ad0d78d7
comparison
equal deleted inserted replaced
23:0edd3412f124 24:4103f0995bd7
177 "\\(\\s-\\|^\\|[-\"\(]\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\s-\\|[-?!.,;:\"\)]\\)") 177 "\\(\\s-\\|^\\|[-\"\(]\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\s-\\|[-?!.,;:\"\)]\\)")
178 (types 178 (types
179 '(("_" "_" underline) 179 '(("_" "_" underline)
180 ("/" "/" italic) 180 ("/" "/" italic)
181 ("\\*" "\\*" bold) 181 ("\\*" "\\*" bold)
182 ;;("_/" "/_" underline-italic) 182 ("_/" "/_" underline-italic)
183 ;;("_\\*" "\\*_" underline-bold) 183 ("_\\*" "\\*_" underline-bold)
184 ("\\*/" "/\\*" bold-italic) 184 ("\\*/" "/\\*" bold-italic)
185 ;;("_\\*/" "/\\*_" underline-bold-italic) 185 ("_\\*/" "/\\*_" underline-bold-italic))))
186 )))
187 `(("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)" 186 `(("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
188 2 3 gnus-emphasis-underline) 187 2 3 gnus-emphasis-underline)
189 ,@(mapcar 188 ,@(mapcar
190 (lambda (spec) 189 (lambda (spec)
191 (list 190 (list
929 buffer-read-only beg end) 928 buffer-read-only beg end)
930 (widen) 929 (widen)
931 (goto-char (point-min)) 930 (goto-char (point-min))
932 ;; Hide the "header". 931 ;; Hide the "header".
933 (when (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t) 932 (when (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
934 (gnus-article-hide-text-type (match-beginning 0) (match-end 0) 'pgp)) 933 (gnus-article-hide-text-type (1+ (match-beginning 0))
934 (match-end 0) 'pgp))
935 (setq beg (point)) 935 (setq beg (point))
936 ;; Hide the actual signature. 936 ;; Hide the actual signature.
937 (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t) 937 (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t)
938 (setq end (1+ (match-beginning 0))) 938 (setq end (1+ (match-beginning 0)))
939 (gnus-article-hide-text-type 939 (gnus-article-hide-text-type
1008 1008
1009 (defun article-strip-multiple-blank-lines () 1009 (defun article-strip-multiple-blank-lines ()
1010 "Replace consecutive blank lines with one empty line." 1010 "Replace consecutive blank lines with one empty line."
1011 (interactive) 1011 (interactive)
1012 (save-excursion 1012 (save-excursion
1013 (let (buffer-read-only) 1013 (let ((inhibit-point-motion-hooks t)
1014 buffer-read-only)
1014 ;; First make all blank lines empty. 1015 ;; First make all blank lines empty.
1015 (goto-char (point-min)) 1016 (goto-char (point-min))
1017 (search-forward "\n\n" nil t)
1016 (while (re-search-forward "^[ \t]+$" nil t) 1018 (while (re-search-forward "^[ \t]+$" nil t)
1017 (replace-match "" nil t)) 1019 (replace-match "" nil t))
1018 ;; Then replace multiple empty lines with a single empty line. 1020 ;; Then replace multiple empty lines with a single empty line.
1019 (goto-char (point-min)) 1021 (goto-char (point-min))
1022 (search-forward "\n\n" nil t)
1020 (while (re-search-forward "\n\n\n+" nil t) 1023 (while (re-search-forward "\n\n\n+" nil t)
1021 (replace-match "\n\n" t t))))) 1024 (replace-match "\n\n" t t)))))
1022 1025
1023 (defun article-strip-blank-lines () 1026 (defun article-strip-blank-lines ()
1024 "Strip leading, trailing and multiple blank lines." 1027 "Strip leading, trailing and multiple blank lines."
2457 "Regular expression that matches URLs." 2460 "Regular expression that matches URLs."
2458 :group 'gnus-article-buttons 2461 :group 'gnus-article-buttons
2459 :type 'regexp) 2462 :type 'regexp)
2460 2463
2461 (defcustom gnus-button-alist 2464 (defcustom gnus-button-alist
2462 `(("\\(\\b<\\(url: ?\\)?news:\\([^>\n\t ]*\\)>\\)" 1 t 2465 `(("<\\(url: ?\\)?news:\\([^>\n\t ]*@[^>\n\t ]*\\)>" 0 t
2463 gnus-button-message-id 3) 2466 gnus-button-message-id 2)
2464 ("\\bnews:\\([^\n\t ]+\\)" 0 t gnus-button-message-id 1) 2467 ("\\bnews:\\([^>\n\t ]*@[^>\n\t ]*+\\)" 0 t gnus-button-message-id 1)
2465 ("\\(\\b<\\(url: ?\\)?news:\\(//\\)?\\([^>\n\t ]*\\)>\\)" 1 t 2468 ("\\(\\b<\\(url: ?\\)?news:\\(//\\)?\\([^>\n\t ]*\\)>\\)" 1 t
2466 gnus-button-fetch-group 4) 2469 gnus-button-fetch-group 4)
2467 ("\\bnews:\\(//\\)?\\([^>\n\t ]+\\)" 0 t gnus-button-fetch-group 2) 2470 ("\\bnews:\\(//\\)?\\([^>\n\t ]+\\)" 0 t gnus-button-fetch-group 2)
2468 ("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 2471 ("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2
2469 t gnus-button-message-id 3) 2472 t gnus-button-message-id 3)
2672 (let ((start (match-beginning 0)) 2675 (let ((start (match-beginning 0))
2673 (end (set-marker (make-marker) (1+ (match-end 0))))) 2676 (end (set-marker (make-marker) (1+ (match-end 0)))))
2674 (gnus-article-add-button start (1- end) 'gnus-signature-toggle 2677 (gnus-article-add-button start (1- end) 'gnus-signature-toggle
2675 end))))))) 2678 end)))))))
2676 2679
2680 (defun gnus-button-in-region-p (b e prop)
2681 "Say whether PROP exists in the region."
2682 (text-property-not-all b e prop nil))
2683
2677 (defun gnus-article-add-buttons (&optional force) 2684 (defun gnus-article-add-buttons (&optional force)
2678 "Find external references in the article and make buttons of them. 2685 "Find external references in the article and make buttons of them.
2679 \"External references\" are things like Message-IDs and URLs, as 2686 \"External references\" are things like Message-IDs and URLs, as
2680 specified by `gnus-button-alist'." 2687 specified by `gnus-button-alist'."
2681 (interactive (list 'force)) 2688 (interactive (list 'force))
2701 (let* ((start (and entry (match-beginning (nth 1 entry)))) 2708 (let* ((start (and entry (match-beginning (nth 1 entry))))
2702 (end (and entry (match-end (nth 1 entry)))) 2709 (end (and entry (match-end (nth 1 entry))))
2703 (from (match-beginning 0))) 2710 (from (match-beginning 0)))
2704 (when (and (or (eq t (nth 1 entry)) 2711 (when (and (or (eq t (nth 1 entry))
2705 (eval (nth 1 entry))) 2712 (eval (nth 1 entry)))
2706 (not (get-text-property (point) 'gnus-callback))) 2713 (not (gnus-button-in-region-p from end 'gnus-callback)))
2707 ;; That optional form returned non-nil, so we add the 2714 ;; That optional form returned non-nil, so we add the
2708 ;; button. 2715 ;; button.
2709 (gnus-article-add-button 2716 (gnus-article-add-button
2710 start end 'gnus-button-push 2717 start end 'gnus-button-push
2711 (car (push (set-marker (make-marker) from) 2718 (car (push (set-marker (make-marker) from)
2816 (set-buffer gnus-summary-buffer) 2823 (set-buffer gnus-summary-buffer)
2817 (gnus-summary-refer-article message-id))) 2824 (gnus-summary-refer-article message-id)))
2818 2825
2819 (defun gnus-button-fetch-group (address) 2826 (defun gnus-button-fetch-group (address)
2820 "Fetch GROUP specified by ADDRESS." 2827 "Fetch GROUP specified by ADDRESS."
2821 (if (not (string-match "^\\([^:/]+\\)\\(:\\([^/]+\\)\\)?/\\(.*\\)$" address)) 2828 (if (not (string-match "[:/]" address))
2822 (error "Can't parse %s" address) 2829 ;; This is just a simple group url.
2823 (gnus-group-read-ephemeral-group 2830 (gnus-group-read-ephemeral-group address gnus-select-method)
2824 (match-string 4 address) 2831 (if (not (string-match "^\\([^:/]+\\)\\(:\\([^/]+\\)/\\)?\\(.*\\)$"
2825 `(nntp ,(match-string 1 address) (nntp-address ,(match-string 1 address)) 2832 address))
2826 (nntp-port-number ,(if (match-end 3) 2833 (error "Can't parse %s" address)
2827 (match-string 3 address) 2834 (gnus-group-read-ephemeral-group
2828 "nntp")))))) 2835 (match-string 4 address)
2836 `(nntp ,(match-string 1 address)
2837 (nntp-address ,(match-string 1 address))
2838 (nntp-port-number ,(if (match-end 3)
2839 (match-string 3 address)
2840 "nntp")))))))
2829 2841
2830 (defun gnus-split-string (string pattern) 2842 (defun gnus-split-string (string pattern)
2831 "Return a list of substrings of STRING which are separated by PATTERN." 2843 "Return a list of substrings of STRING which are separated by PATTERN."
2832 (let (parts (start 0)) 2844 (let (parts (start 0))
2833 (while (string-match pattern string start) 2845 (while (string-match pattern string start)