Sync up with Pterodactyl Gnus v0.61.
authoryamaoka <yamaoka>
Wed, 2 Dec 1998 23:04:58 +0000 (23:04 +0000)
committeryamaoka <yamaoka>
Wed, 2 Dec 1998 23:04:58 +0000 (23:04 +0000)
lisp/ChangeLog
lisp/gnus-art.el
lisp/gnus-picon.el
lisp/gnus-sum.el
lisp/gnus.el
lisp/message.el
lisp/mml.el
lisp/rfc2047.el

index c93ef26..7aa0e54 100644 (file)
@@ -1,3 +1,64 @@
+Wed Dec  2 20:24:27 1998  Lars Magne Ingebrigtsen  <larsi@menja.ifi.uio.no>
+
+       * gnus.el: Pterodactyl Gnus v0.61 is released.
+
+1998-12-02 21:12:56  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * mml.el (mml-parse-1): Skipped parts.
+       (mml-insert-mime-headers): Nil is a list.
+       (mml-generate-mime-1): Don't insert literally.
+       (mml-read-tag): Drop text props.
+       (mml-read-part): Ditto.
+       (mml-parse-singlepart-with-multiple-charsets): Ditto.
+
+Wed Dec  2 20:07:16 1998  Lars Magne Ingebrigtsen  <larsi@menja.ifi.uio.no>
+
+       * gnus.el: Pterodactyl Gnus v0.60 is released.
+
+1998-12-02 20:11:28  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * mml.el (mml-parse-1): Don't throw contents away.
+
+1998-12-02  Hrvoje Niksic  <hniksic@srce.hr>
+
+       * mml.el (mml-compute-boundary-1): Regexp-quote the boundary.
+
+1998-12-02 18:42:24  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * mml.el (mml-parse-singlepart-with-multiple-charsets): New
+       function.
+       (mml-parse-1): Use it.
+
+Tue Dec  1 23:04:25 1998  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * gnus-art.el (gnus-decode-with-mail-decode-encoded-word-region):
+       Use gnus-newsgroup-default-charset.
+       (article-decode-encoded-words): Remove charset codes.
+       * gnus-sum.el (gnus-newsgroup-default-charset): Use
+       gnus-default-charset.
+
+1998-12-02 03:14:20  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * message.el (message-send-mail): Don't encode here.
+       (message-send-news): Nor here.
+       (message-send): ... but here instead.
+
+       * gnus-picon.el (gnus-picons-display-article-move-p): Changed
+       default to nil.
+       (gnus-article-display-picons): Replace From line.
+       (gnus-group-display-picons): Replace Newsgroups line.
+       (gnus-picons-display-glyph): Set baseline.
+       (gnus-group-display-picons): Piconize the entire Newsgroups line. 
+       (gnus-picons-xbm-face): Revert to old, standard colors.
+
+       * message.el (message-fetch-field): Remove text props.
+
+       * gnus-art.el (gnus-article-normalized-header-length): New
+       variable. 
+       (article-normalize-headers): New command and keystroke.
+
+       * gnus-picon.el (gnus-picons-xbm-face): Changed colors.
+
 Wed Dec  2 01:43:48 1998  Lars Magne Ingebrigtsen  <larsi@menja.ifi.uio.no>
 
        * gnus.el: Pterodactyl Gnus v0.59 is released.
index d8395e8..ff364b8 100644 (file)
@@ -912,6 +912,37 @@ always hide."
           (point-max)))
        'boring-headers))))
 
+(defvar gnus-article-normalized-header-length 40
+  "Length of normalized headers.")
+
+(defun article-normalize-headers ()
+  "Make all header lines 40 characters long."
+  (interactive)
+  (let ((buffer-read-only nil)
+       column)
+    (save-excursion
+      (save-restriction
+       (message-narrow-to-head)
+       (while (not (eobp))
+         (cond
+          ((< (setq column (- (gnus-point-at-eol) (point)))
+              gnus-article-normalized-header-length)
+           (end-of-line)
+           (insert (make-string
+                    (- gnus-article-normalized-header-length column)
+                    ? )))
+          ((> column gnus-article-normalized-header-length)
+           (gnus-put-text-property
+            (progn
+              (forward-char gnus-article-normalized-header-length)
+              (point))
+            (gnus-point-at-eol)
+            'invisible t))
+          (t
+           ;; Do nothing.
+           ))
+         (forward-line 1))))))
+
 (defun article-treat-dumbquotes ()
   "Translate M******** sm*rtq**t*s into proper text."
   (interactive)
@@ -1997,6 +2028,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
      article-date-lapsed
      article-emphasize
      article-treat-dumbquotes
+     article-normalize-headers
      (article-show-all . gnus-article-show-all-headers))))
 \f
 ;;;
@@ -4065,7 +4097,7 @@ forbidden in URL encoding."
 
 (defvar gnus-decode-header-methods
   '(gnus-decode-with-mail-decode-encoded-word-region)
-  "List of methods used to decode headers
+  "List of methods used to decode headers.
 
 This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item is
 FUNCTION, FUNCTION will be apply to all newsgroups. If item is a
@@ -4081,7 +4113,8 @@ For example:
 (defvar gnus-decode-header-methods-cache nil)
 
 (defun gnus-decode-with-mail-decode-encoded-word-region (start end)
-  (let ((rfc2047-default-charset gnus-default-charset))
+  (let ((rfc2047-default-charset gnus-newsgroup-default-charset)
+       (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced))
     (mail-decode-encoded-word-region start end)))
 
 (defun gnus-multi-decode-header (start end)
index 26e82db..ace8fd7 100644 (file)
@@ -117,7 +117,7 @@ Some people may want to add \"unknown\" to this list."
   :type '(repeat string)
   :group 'picons)
 
-(defcustom gnus-picons-display-article-move-p t
+(defcustom gnus-picons-display-article-move-p nil
   "*Whether to move point to first empty line when displaying picons.
 This has only an effect if `gnus-picons-display-where' has value `article'."
   :type 'boolean
@@ -144,11 +144,7 @@ please tell me so that we can list it."
                 (string))
   :group 'picons)
 
-(defface gnus-picons-xbm-face
-  '((((background dark))
-     (:foreground "green" :background "black"))
-    (t
-     (:foreground "black" :background "blue")))
+(defface gnus-picons-xbm-face '((t (:foreground "black" :background "white")))
   "Face to show xbm picons in."
   :group 'picons)
 
@@ -313,6 +309,15 @@ To use:  (setq gnus-article-x-face-command 'gnus-picons-display-x-face)"
                                                "."))))
          (gnus-picons-prepare-for-annotations)
          (gnus-group-display-picons)
+         (unless gnus-picons-display-article-move-p
+           (save-restriction
+             (let ((buffer-read-only nil))
+               (when (re-search-forward "^From: " nil t)
+                 (narrow-to-region (point) (gnus-point-at-eol))
+                 (when (search-forward from nil t)
+                   (gnus-put-text-property
+                    (match-beginning 0) (match-end 0)
+                    'invisible t))))))
          (if (null gnus-picons-piconsearch-url)
              (progn
                (gnus-picons-display-pairs (gnus-picons-lookup-pairs
@@ -339,27 +344,40 @@ To use:  (setq gnus-article-x-face-command 'gnus-picons-display-x-face)"
             (or (null gnus-picons-group-excluded-groups)
                 (not (string-match gnus-picons-group-excluded-groups
                                    gnus-newsgroup-name))))
-    (save-excursion
-      (gnus-picons-prepare-for-annotations)
-      (if (null gnus-picons-piconsearch-url)
-         (gnus-picons-display-pairs
-                (gnus-picons-lookup-pairs
-                 (reverse (message-tokenize-header
-                           (gnus-group-real-name gnus-newsgroup-name) 
-                           "."))
-                 gnus-picons-news-directories)
-                t ".")
-       (push (list 'gnus-group-annotations 'search nil
-                   (message-tokenize-header 
-                    (gnus-group-real-name gnus-newsgroup-name) ".")
-                   (if (listp gnus-picons-news-directories)
-                       gnus-picons-news-directories
-                     (list gnus-picons-news-directories))
-                   nil)
-             gnus-picons-jobs-alist)
-       (gnus-picons-next-job))
-
-      (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all))))
+    (let ((groups
+          (if gnus-picons-display-article-move-p
+              (list (gnus-group-real-name gnus-newsgroup-name))
+            (split-string (mail-fetch-field "newsgroups") ",")))
+         group)
+      (save-excursion
+       (gnus-picons-prepare-for-annotations)
+       (while (setq group (pop groups))
+         (unless gnus-picons-display-article-move-p
+           (save-restriction
+             (let ((buffer-read-only nil))
+               (goto-char (point-min))
+               (when (re-search-forward "^Newsgroups:" nil t)
+                 (narrow-to-region (point) (gnus-point-at-eol))
+                 (when (search-forward group nil t)
+                   (gnus-put-text-property
+                    (match-beginning 0) (match-end 0)
+                    'invisible t))))))
+         (if (null gnus-picons-piconsearch-url)
+             (gnus-picons-display-pairs
+              (gnus-picons-lookup-pairs
+               (reverse (split-string group "\\."))
+               gnus-picons-news-directories)
+              t ".")
+           (push (list 'gnus-group-annotations 'search nil
+                       (split-string group "\\.")
+                       (if (listp gnus-picons-news-directories)
+                           gnus-picons-news-directories
+                         (list gnus-picons-news-directories))
+                       nil)
+                 gnus-picons-jobs-alist)
+           (gnus-picons-next-job))
+
+         (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all))))))
 
 (defun gnus-picons-lookup-internal (addrs dir)
   (setq dir (expand-file-name dir gnus-picons-database))
@@ -421,7 +439,8 @@ none, and whose CDR is the corresponding element of DOMAINS."
   "Display picons in list PAIRS."
   (let ((domain-p (and gnus-picons-display-as-address dot-p))
        pair picons)
-    (when (and bar-p domain-p right-p)
+    (when (and bar-p domain-p right-p
+              gnus-picons-display-article-move-p)
       (setq picons (gnus-picons-display-glyph
                    (let ((gnus-picons-file-suffixes '("xbm")))
                      (gnus-picons-try-face
@@ -456,6 +475,7 @@ none, and whose CDR is the corresponding element of DOMAINS."
     glyph))
 
 (defun gnus-picons-display-glyph (glyph &optional part rightp)
+  (set-glyph-baseline glyph 70)
   (let ((new (gnus-picons-make-annotation
              glyph (point) 'text nil nil nil rightp)))
     (when (and part gnus-picons-display-as-address)
@@ -718,7 +738,8 @@ none, and whose CDR is the corresponding element of DOMAINS."
            (cond ((stringp tag);; (SYM-ANN "..." RIGHT-P)
                   (gnus-picons-network-display-internal sym-ann nil tag
                                                         (pop job)))
-                 ((eq 'bar tag)
+                 ((and (eq 'bar tag)
+                       gnus-picons-display-article-move-p)
                   (gnus-picons-network-display-internal
                    sym-ann
                    (let ((gnus-picons-file-suffixes '("xbm")))
index e06c722..e75633b 100644 (file)
@@ -1018,7 +1018,7 @@ variable (string, integer, character, etc).")
 (defvar gnus-last-article nil)
 (defvar gnus-newsgroup-history nil)
 
-(defvar gnus-newsgroup-default-charset nil)
+(defvar gnus-newsgroup-default-charset gnus-default-charset)
 (defvar gnus-newsgroup-iso-8859-1-forced nil)
 
 (defconst gnus-summary-local-variables
index 6080f27..47c65ee 100644 (file)
@@ -259,17 +259,17 @@ is restarted, and sometimes reloaded."
 (defconst gnus-product-name "T-gnus"
   "Product name of this version of gnus.")
 
-(defconst gnus-version-number "6.10.045"
+(defconst gnus-version-number "6.10.046"
   "Version number for this version of gnus.")
 
-(defconst gnus-original-version-number "0.59"
+(defconst gnus-original-version-number "0.61"
     "Version number for this version of Gnus.")
 
 (defconst gnus-original-product-name "Pterodactyl Gnus"
   "Product name of the original version of Gnus.")
 
 (defconst gnus-version
-  (format "%s %s (based on %s %s ; for SEMI 1.11/1.12, FLIM 1.12)"
+  (format "%s %s (based on %s %s ; for SEMI 1.12, FLIM 1.12)"
          gnus-product-name gnus-version-number
          gnus-original-product-name gnus-original-version-number)
   "Version string for this version of gnus.")
index 7eaab73..bd35833 100644 (file)
@@ -1238,7 +1238,8 @@ This variable is used only in non-Mule Emacsen.")
     (when value
       (while (string-match "\n[\t ]+" value)
        (setq value (replace-match " " t t value)))
-      value)))
+      ;; We remove all text props.delete-region
+      (format "%s" value))))
 
 (defun message-narrow-to-field ()
   "Narrow the buffer to the header on the current line."
index f788a9e..5184ace 100644 (file)
   
 (defun mml-parse-1 ()
   "Parse the current buffer as an MML document."
-  (let (struct)
+  (let (struct tag point contents charsets warn)
     (while (and (not (eobp))
                (not (looking-at "<#/multipart")))
       (cond
        ((looking-at "<#multipart")
        (push (nconc (mml-read-tag) (mml-parse-1)) struct))
-       ((looking-at "<#part")
-       (push (nconc (mml-read-tag) (list (cons 'contents (mml-read-part))))
-             struct))
        ((looking-at "<#external")
        (push (nconc (mml-read-tag) (list (cons 'contents (mml-read-part))))
              struct))
        (t
-       (push (list 'part '(type . "text/plain")
-                   (cons 'contents (mml-read-part))) struct))))
+       (if (looking-at "<#part")
+           (setq tag (mml-read-tag))
+         (setq tag (list 'part '(type . "text/plain"))
+               warn t))
+       (setq point (point)
+             contents (mml-read-part)
+             charsets (delq 'ascii (mm-find-charset-region point (point))))
+       (if (< (length charsets) 2)
+           (push (nconc tag (list (cons 'contents contents)))
+                 struct)
+         (let ((nstruct (mml-parse-singlepart-with-multiple-charsets
+                         tag point (point))))
+           (when (and warn
+                      (not
+                       (y-or-n-p
+                        (format
+                         "Warning: Your message contains %d parts.  Really send? "
+                         (length nstruct)))))
+             (error "Edit your message to use only one charset"))
+           (setq struct (nconc nstruct struct)))))))
     (unless (eobp)
       (forward-line 1))
     (nreverse struct)))
 
+(defun mml-parse-singlepart-with-multiple-charsets (orig-tag beg end)
+  (save-excursion
+    (narrow-to-region beg end)
+    (goto-char (point-min))
+    (let ((current (char-charset (following-char)))
+         charset struct space newline paragraph)
+      (while (not (eobp))
+       (cond
+        ;; The charset remains the same.
+        ((or (eq (setq charset (char-charset (following-char))) 'ascii)
+             (eq charset current)))
+        ;; The initial charset was ascii.
+        ((eq current 'ascii)
+         (setq current charset))
+        ;; We have a change in charsets.
+        (t
+         (push (append
+                orig-tag
+                (list (cons 'contents
+                            (buffer-substring-no-properties
+                             beg (or paragraph newline space (point))))))
+               struct)
+         (setq beg (or paragraph newline space (point))
+               current charset
+               space nil
+               newline nil
+               paragraph nil)))
+       ;; Compute places where it might be nice to break the part.
+       (cond
+        ((memq (following-char) '(?  ?\t))
+         (setq space (1+ (point))))
+        ((eq (following-char) ?\n)
+         (setq newline (1+ (point))))
+        ((and (eq (following-char) ?\n)
+              (not (bobp))
+              (eq (char-after (1- (point))) ?\n))
+         (setq paragraph (point))))
+       (forward-char 1))
+      ;; Do the final part.
+      (unless (= beg (point))
+       (push (append orig-tag
+                     (list (cons 'contents
+                                 (buffer-substring-no-properties
+                                  beg (point)))))
+             struct))
+      struct)))
+
 (defun mml-read-tag ()
   "Read a tag and return the contents."
   (let (contents name elem val)
     (forward-char 2)
-    (setq name (buffer-substring (point) (progn (forward-sexp 1) (point))))
+    (setq name (buffer-substring-no-properties
+               (point) (progn (forward-sexp 1) (point))))
     (skip-chars-forward " \t\n")
     (while (not (looking-at ">"))
-      (setq elem (buffer-substring (point) (progn (forward-sexp 1) (point))))
+      (setq elem (buffer-substring-no-properties
+                 (point) (progn (forward-sexp 1) (point))))
       (skip-chars-forward "= \t\n")
-      (setq val (buffer-substring (point) (progn (forward-sexp 1) (point))))
+      (setq val (buffer-substring-no-properties
+                (point) (progn (forward-sexp 1) (point))))
       (when (string-match "^\"\\(.*\\)\"$" val)
        (setq val (match-string 1 val)))
       (push (cons (intern elem) val) contents)
     (if (re-search-forward
         "<#\\(/\\)?\\(multipart\\|part\\|external\\)." nil t)
        (prog1
-           (buffer-substring beg (match-beginning 0))
+           (buffer-substring-no-properties beg (match-beginning 0))
          (if (or (not (match-beginning 1))
                  (equal (match-string 2) "multipart"))
              (goto-char (match-beginning 0))
            (when (looking-at "[ \t]*\n")
              (forward-line 1))))
-      (buffer-substring beg (goto-char (point-max))))))
+      (buffer-substring-no-properties beg (goto-char (point-max))))))
 
 (defvar mml-boundary nil)
 (defvar mml-base-boundary "=-=-=")
            (setq coded (buffer-string)))
        (mm-with-unibyte-buffer
          (if (setq filename (cdr (assq 'filename cont)))
-             (insert-file-contents-literally filename)
+             (insert-file-contents filename)
            (insert (cdr (assq 'contents cont))))
          (setq encoding (mm-encode-buffer type)
                coded (buffer-string))))
            (insert-file-contents-literally filename)
          (insert (cdr (assq 'contents cont))))
        (goto-char (point-min))
-       (when (re-search-forward (concat "^--" mml-boundary) nil t)
+       (when (re-search-forward (concat "^--" (regexp-quote mml-boundary))
+                                nil t)
          (setq mml-boundary (mml-make-boundary))
          (throw 'not-unique nil))))
      ((eq (car cont) 'multipart)
                    (mml-parameter-string
                     cont '(name access-type expiration size permission)))
              (not (equal type "text/plain")))
-      (when (listp charset)
+      (when (consp charset)
+       (debug)
        (error
         "Can't encode a part with several charsets.  Insert a <#part>."))
       (insert "Content-Type: " type)
index 3484a04..47d1161 100644 (file)
@@ -147,7 +147,7 @@ Should be called narrowed to the head of the message."
     found))
 
 (defun rfc2047-dissect-region (b e)
-  "Dissect the region between B and E."
+  "Dissect the region between B and E into words."
   (let (words)
     (save-restriction
       (narrow-to-region b e)
@@ -156,10 +156,8 @@ Should be called narrowed to the head of the message."
              (concat "[^" ietf-drums-tspecials " \t\n]+") nil t)
        (push
         (list (match-beginning 0) (match-end 0)
-              (car
-               (delq 'ascii
-                     (find-charset-region (match-beginning 0)
-                                          (match-end 0)))))
+              (car (delq 'ascii (find-charset-region
+                                 (match-beginning 0) (match-end 0)))))
         words))
       words)))