(gnus-point-at-bol, gnus-point-at-eol): Remove.
[gnus] / lisp / gnus-art.el
index db8c311..b134501 100644 (file)
@@ -396,7 +396,9 @@ and the latter avoids underlining any whitespace at all."
 Example: (_/*word*/_)."
   :group 'gnus-article-emphasis)
 
-(defface gnus-emphasis-strikethru '((t (:strikethru t)))
+(defface gnus-emphasis-strikethru (if (featurep 'xemacs)
+                                     '((t (:strikethru t)))
+                                   '((t (:strike-through t))))
   "Face used for displaying strike-through text (-word-)."
   :group 'gnus-article-emphasis)
 
@@ -1271,12 +1273,12 @@ See Info node `(gnus)Customizing Articles' and Info node
          gnus-treat-from-picon)
       'head nil)
   "Draw a boundary at the end of the headers.
-Valid values are nil, t, `head', `last', an integer or a predicate.
+Valid values are nil and `head'.
 See Info node `(gnus)Customizing Articles' for details."
   :version "21.1"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
-  :type gnus-article-treat-custom)
+  :type gnus-article-treat-head-custom)
 
 (defcustom gnus-treat-capitalize-sentences nil
   "Capitalize sentence-starting words.
@@ -1627,7 +1629,7 @@ always hide."
              (while (re-search-forward "^[^: \t]+:[ \t]*\n[^ \t]" nil t)
                (forward-line -1)
                (gnus-article-hide-text-type
-                (gnus-point-at-bol)
+                (point-at-bol)
                 (progn
                   (end-of-line)
                   (if (re-search-forward "^[^ \t]" nil t)
@@ -1693,12 +1695,19 @@ always hide."
                  (gnus-article-hide-header "reply-to")
                (let ((from (message-fetch-field "from"))
                      (reply-to (message-fetch-field "reply-to")))
-                 (when (and
-                        from reply-to
-                        (ignore-errors
-                          (gnus-string-equal
-                           (nth 1 (mail-extract-address-components from))
-                           (nth 1 (mail-extract-address-components reply-to)))))
+                 (when
+                     (and
+                      from reply-to
+                      (ignore-errors
+                        (equal
+                         (sort (mapcar
+                                (lambda (x) (downcase (cadr x)))
+                                (mail-extract-address-components from t))
+                               'string<)
+                         (sort (mapcar
+                                (lambda (x) (downcase (cadr x)))
+                                (mail-extract-address-components reply-to t))
+                               'string<))))
                    (gnus-article-hide-header "reply-to")))))
             ((eq elem 'date)
              (let ((date (message-fetch-field "date")))
@@ -1746,7 +1755,7 @@ always hide."
     (goto-char (point-min))
     (when (re-search-forward (concat "^" header ":") nil t)
       (gnus-article-hide-text-type
-       (gnus-point-at-bol)
+       (point-at-bol)
        (progn
         (end-of-line)
         (if (re-search-forward "^[^ \t]" nil t)
@@ -1767,7 +1776,7 @@ always hide."
        (article-narrow-to-head)
        (while (not (eobp))
          (cond
-          ((< (setq column (- (gnus-point-at-eol) (point)))
+          ((< (setq column (- (point-at-eol) (point)))
               gnus-article-normalized-header-length)
            (end-of-line)
            (insert (make-string
@@ -1778,7 +1787,7 @@ always hide."
             (progn
               (forward-char gnus-article-normalized-header-length)
               (point))
-            (gnus-point-at-eol)
+            (point-at-eol)
             'invisible t))
           (t
            ;; Do nothing.
@@ -1786,14 +1795,15 @@ always hide."
          (forward-line 1))))))
 
 (defun article-treat-dumbquotes ()
-  "Translate M****s*** sm*rtq**t*s into proper text.
+  "Translate M****s*** sm*rtq**t*s and other symbols into proper text.
 Note that this function guesses whether a character is a sm*rtq**t* or
 not, so it should only be used interactively.
 
-Sm*rtq**t*s are M****s***'s unilateral extension to the character map
-in an attempt to provide more quoting characters.  If you see
-something like \\222 or \\264 where you're expecting some kind of
-apostrophe or quotation mark, then try this wash."
+Sm*rtq**t*s are M****s***'s unilateral extension to the
+iso-8859-1 character map in an attempt to provide more quoting
+characters.  If you see something like \\222 or \\264 where
+you're expecting some kind of apostrophe or quotation mark, then
+try this wash."
   (interactive)
   (article-translate-strings gnus-article-dumbquotes-map))
 
@@ -1948,7 +1958,7 @@ unfolded."
            (end-of-line)
            (when (>= (current-column) (min fill-column width))
              (narrow-to-region (min (1+ (point)) (point-max))
-                               (gnus-point-at-bol))
+                               (point-at-bol))
               (let ((goback (point-marker)))
                 (fill-paragraph nil)
                 (goto-char (marker-position goback)))
@@ -1990,7 +2000,7 @@ unfolded."
         (while (and (not (bobp))
                     (looking-at "^[ \t]*$")
                     (not (gnus-annotation-in-region-p
-                          (point) (gnus-point-at-eol))))
+                          (point) (point-at-eol))))
           (forward-line -1))
         (forward-line 1)
         (point))))))
@@ -2751,11 +2761,11 @@ should replace the \"Date:\" one, or should be added below it."
       (save-restriction
        (article-narrow-to-head)
        (when (re-search-forward tdate-regexp nil t)
-         (setq bface (get-text-property (gnus-point-at-bol) 'face)
-               date (or (get-text-property (gnus-point-at-bol)
+         (setq bface (get-text-property (point-at-bol) 'face)
+               date (or (get-text-property (point-at-bol)
                                            'original-date)
                         date)
-               eface (get-text-property (1- (gnus-point-at-eol)) 'face))
+               eface (get-text-property (1- (point-at-eol)) 'face))
          (forward-line 1))
        (when (and date (not (string= date "")))
          (goto-char (point-min))
@@ -3408,8 +3418,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is
                (message-narrow-to-head)
                (goto-char (point-max))
                (forward-line -1)
-               (setq bface (get-text-property (gnus-point-at-bol) 'face)
-                     eface (get-text-property (1- (gnus-point-at-eol)) 'face))
+               (setq bface (get-text-property (point-at-bol) 'face)
+                     eface (get-text-property (1- (point-at-eol)) 'face))
                (message-remove-header "X-Gnus-PGP-Verify")
                (if (re-search-forward "^X-PGP-Sig:" nil t)
                    (forward-line)
@@ -3601,7 +3611,7 @@ commands:
       (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map)))
   (gnus-update-format-specifications nil 'article-mode)
   (set (make-local-variable 'page-delimiter) gnus-page-delimiter)
-  (make-local-variable 'gnus-page-broken)
+  (set (make-local-variable 'gnus-page-broken) nil)
   (make-local-variable 'gnus-button-marker-list)
   (make-local-variable 'gnus-article-current-summary)
   (make-local-variable 'gnus-article-mime-handles)
@@ -3785,10 +3795,8 @@ If ALL-HEADERS is non-nil, no headers are hidden."
              (gnus-article-prepare-display)
              ;; Do page break.
              (goto-char (point-min))
-             (setq gnus-page-broken
-                   (when gnus-break-pages
-                     (gnus-narrow-to-page)
-                     t)))
+             (when gnus-break-pages
+               (gnus-narrow-to-page)))
            (let ((gnus-article-mime-handle-alist-1
                   gnus-article-mime-handle-alist))
              (gnus-set-mode-line 'article))
@@ -3885,22 +3893,6 @@ General format specifiers can also be used.  See Info node
                (vector (caddr c) (car c) :enable t))
              gnus-mime-button-commands)))
 
-(eval-when-compile
-  (define-compiler-macro popup-menu (&whole form
-                                           menu &optional position prefix)
-    (if (and (fboundp 'popup-menu)
-            (not (memq 'popup-menu (assoc "lmenu" load-history))))
-       form
-      ;; Gnus is probably running under Emacs 20.
-      `(let* ((menu (cdr ,menu))
-             (response (x-popup-menu
-                        t (list (car menu)
-                                (cons "" (mapcar (lambda (c)
-                                                   (cons (caddr c) (car c)))
-                                                 (cdr menu)))))))
-        (if response
-            (call-interactively (nth 3 (assq response menu))))))))
-
 (defun gnus-mime-button-menu (event prefix)
  "Construct a context-sensitive menu of MIME commands."
  (interactive "e\nP")
@@ -4934,27 +4926,32 @@ If given a numerical ARG, move forward ARG pages."
       (let ((buffer-read-only nil))
        (gnus-remove-text-with-property 'gnus-prev)
        (gnus-remove-text-with-property 'gnus-next)))
-    (when
+    (if
        (cond ((< arg 0)
               (re-search-backward page-delimiter nil 'move (1+ (abs arg))))
              ((> arg 0)
               (re-search-forward page-delimiter nil 'move arg)))
-      (goto-char (match-end 0)))
-    (narrow-to-region
-     (point)
-     (if (re-search-forward page-delimiter nil 'move)
-        (match-beginning 0)
-       (point)))
-    (when (and (gnus-visual-p 'page-marker)
-              (not (= (point-min) 1)))
+       (goto-char (match-end 0))
       (save-excursion
        (goto-char (point-min))
-       (gnus-insert-prev-page-button)))
-    (when (and (gnus-visual-p 'page-marker)
-              (< (+ (point-max) 2) (buffer-size)))
-      (save-excursion
-       (goto-char (point-max))
-       (gnus-insert-next-page-button)))))
+       (setq gnus-page-broken
+             (and (re-search-forward page-delimiter nil t) t))))
+    (when gnus-page-broken
+      (narrow-to-region
+       (point)
+       (if (re-search-forward page-delimiter nil 'move)
+          (match-beginning 0)
+        (point)))
+      (when (and (gnus-visual-p 'page-marker)
+                (not (= (point-min) 1)))
+       (save-excursion
+         (goto-char (point-min))
+         (gnus-insert-prev-page-button)))
+      (when (and (gnus-visual-p 'page-marker)
+                (< (+ (point-max) 2) (buffer-size)))
+       (save-excursion
+         (goto-char (point-max))
+         (gnus-insert-next-page-button))))))
 
 ;; Article mode commands
 
@@ -4967,7 +4964,7 @@ If given a numerical ARG, move forward ARG pages."
 
 
 (defun gnus-article-goto-prev-page ()
-  "Show the next page of the article."
+  "Show the previous page of the article."
   (interactive)
   (if (bobp)
       (gnus-article-read-summary-keys nil (gnus-character-to-event ?p))
@@ -5063,9 +5060,9 @@ not have a face in `gnus-article-boring-faces'."
   "Read article specified by message-id around point."
   (interactive)
   (save-excursion
-    (re-search-backward "[ \t]\\|^" (gnus-point-at-bol) t)
-    (re-search-forward "<?news:<?\\|<" (gnus-point-at-eol) t)
-    (if (re-search-forward "[^@ ]+@[^ \t>]+" (gnus-point-at-eol) t)
+    (re-search-backward "[ \t]\\|^" (point-at-bol) t)
+    (re-search-forward "<?news:<?\\|<" (point-at-eol) t)
+    (if (re-search-forward "[^@ ]+@[^ \t>]+" (point-at-eol) t)
        (let ((msg-id (concat "<" (match-string 0) ">")))
          (set-buffer gnus-summary-buffer)
          (gnus-summary-refer-article msg-id))
@@ -5729,7 +5726,8 @@ It should match all directories in the top level of `gnus-ctan-url'."
   :type 'regexp)
 
 (defcustom gnus-button-mid-or-mail-regexp
-  (concat "\\b\\(<?[a-z0-9][^<>\")!;:,{}\n\t ]*@"
+  (concat "\\b\\(<?[a-z0-9$%(*-=?[_][^<>\")!;:,{}\n\t ]*@"
+         ;; Felix Wiemann in <87oeuomcz9.fsf@news2.ososo.de>
          gnus-button-valid-fqdn-regexp
          ">?\\)\\b")
   "Regular expression that matches a message ID or a mail address."
@@ -5824,13 +5822,14 @@ address, `ask' if unsure and `invalid' if the string is invalid."
     ;; Certain special cases...
     (when (string-match
           (concat
-           "^0[0-9]+-[0-9][0-9][0-9][0-9]@t-online\\.de$" "\\|"
-           "^[0-9]+\.[0-9]+\@compuserve")
+           "^0[0-9]+-[0-9][0-9][0-9][0-9]@t-online\\.de$\\|"
+           "^[0-9]+\\.[0-9]+@compuserve\\|"
+           "@public\\.gmane\\.org")
           mid-or-mail)
-      (gnus-message 8 "`%s' is a known mail address.")
+      (gnus-message 8 "`%s' is a known mail address." mid-or-mail)
       (setq result 'mail))
     (when (string-match "@.*@\\| " mid-or-mail)
-      (gnus-message 8 "`%s' is invalid.")
+      (gnus-message 8 "`%s' is invalid." mid-or-mail)
       (setq result 'invalid))
     ;; Nothing more to do, if result is not a number here...
     (when (numberp result)
@@ -5872,8 +5871,10 @@ address, `ask' if unsure and `invalid' if the string is invalid."
          (gnus-message
           9 "`%s', rate `%s', result `%s'." mid-or-mail 5.0 result)))))
     (gnus-message 8 "`%s': Final rate is `%s'." mid-or-mail result)
+    ;; Maybe we should make this a customizable alist: (condition . 'result)
     (cond
-     ;; Maybe we should make this a customizable alist: (condition . 'result)
+     ((symbolp result) result)
+     ;; Now convert number into proper results:
      ((< result -10.0) 'mid)
      ((> result  10.0) 'mail)
      (t 'ask))))
@@ -6039,11 +6040,15 @@ positives are possible."
      1 (>= gnus-button-message-level 0) gnus-button-fetch-group 5)
     ("\\b\\(nntp\\|news\\):\\(//\\)?\\([^'\">\n\t ]+\\)"
      0 (>= gnus-button-message-level 0) gnus-button-fetch-group 3)
+    ;; RFC 2392 (Don't allow `/' in domain part --> CID)
+    ("\\bmid:\\(//\\)?\\([^'\">\n\t ]+@[^'\">\n\t /]+\\)"
+     0 (>= gnus-button-message-level 0) gnus-button-message-id 2)
     ("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)"
      2 (>= gnus-button-message-level 0) gnus-button-message-id 3)
     ("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>"
      0 (>= gnus-button-message-level 0) gnus-url-mailto 2)
-    ("mailto:\\([-a-z.@_+0-9%=?]+\\)"
+    ;; RFC 2368 (The mailto URL scheme)
+    ("mailto:\\([-a-z.@_+0-9%=?&]+\\)"
      0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
     ("\\bmailto:\\([^ \n\t]+\\)"
      0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
@@ -6102,6 +6107,8 @@ positives are possible."
      0 (>= gnus-button-emacs-level 9) gnus-button-handle-symbol 1)
     ("(setq[ \t\n]+\\([a-z][a-z0-9]+-[-a-z0-9]+\\)[ \t\n]+.+)"
      1 (>= gnus-button-emacs-level 7) gnus-button-handle-describe-variable 1)
+    ("\\bM-x[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
+     1 (>= gnus-button-emacs-level 7) gnus-button-handle-describe-function 1)
     ("\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+f[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
      0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-function 2)
     ("\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+v[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
@@ -6110,9 +6117,15 @@ positives are possible."
      ;; Unlike the other regexps we really have to require quoting
      ;; here to determine where it ends.
      1 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-key 3)
-    ;; This is how URLs _should_ be embedded in text (RFC 1738)...
+    ;; This is how URLs _should_ be embedded in text (RFC 1738, RFC 2396)...
     ("<URL: *\\([^<>]*\\)>"
      1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
+    ;; RFC 2396 (2.4.3., delims) ...
+    ("\"URL: *\\([^\"]*\\)\""
+     1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
+    ;; RFC 2396 (2.4.3., delims) ...
+    ("\"URL: *\\([^\"]*\\)\""
+     1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
     ;; Raw URLs.
     (gnus-button-url-regexp
      0 (>= gnus-button-browse-level 0) browse-url 0)
@@ -6170,7 +6183,7 @@ variable it the real callback function."
      0 (>= gnus-button-browse-level 0) browse-url 0)
     ("^[^:]+:" gnus-button-url-regexp
      0 (>= gnus-button-browse-level 0) browse-url 0)
-    ("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?]+\\)"
+    ("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?&]+\\)"
      0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
     ("^[^:]+:" "\\(<\\(url: \\)?\\(nntp\\|news\\):\\([^>\n ]*\\)>\\)"
      1 (>= gnus-button-message-level 0) gnus-button-message-id 4))
@@ -6607,12 +6620,14 @@ specified by `gnus-button-alist'."
   (when (string-match "mailto:/*\\(.*\\)" url)
     (setq url (substring url (match-beginning 1) nil)))
   (let (to args subject func)
-    (if (string-match (regexp-quote "?") url)
-       (setq to (gnus-url-unhex-string (substring url 0 (match-beginning 0)))
-             args (gnus-url-parse-query-string
-                   (substring url (match-end 0) nil) t))
-      (setq to (gnus-url-unhex-string url)))
-    (setq args (cons (list "to" to) args)
+    (setq args (gnus-url-parse-query-string
+               (if (string-match "^\\?" url)
+                   (substring url 1)
+                 (if (string-match "^\\([^?]+\\)\\?\\(.*\\)" url)
+                     (concat "to=" (match-string 1 url) "&"
+                             (match-string 2 url))
+                   (concat "to=" url)))
+               t)
          subject (cdr-safe (assoc "subject" args)))
     (gnus-msg-mail)
     (while args
@@ -6620,7 +6635,9 @@ specified by `gnus-button-alist'."
       (if (fboundp func)
          (funcall func)
        (message-position-on-field (caar args)))
-      (insert (mapconcat 'identity (cdar args) ", "))
+      (insert (gnus-replace-in-string
+              (mapconcat 'identity (reverse (cdar args)) ", ")
+              "\r\n" "\n" t))
       (setq args (cdr args)))
     (if subject
        (message-goto-body)