From 49338d152b84e5e48284fa8deef4f138a3bf4a93 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Wed, 2 Dec 1998 22:17:48 +0000 Subject: [PATCH] Importing Pterodactyl Gnus v0.61. --- lisp/ChangeLog | 61 +++++++++++++++++++++++++++++++++ lisp/gnus-art.el | 42 +++++++++++++++++++---- lisp/gnus-picon.el | 79 +++++++++++++++++++++++++++---------------- lisp/gnus-sum.el | 2 +- lisp/gnus.el | 2 +- lisp/message.el | 6 ++-- lisp/mm-uu.el | 2 +- lisp/mml.el | 95 ++++++++++++++++++++++++++++++++++++++++++++-------- lisp/rfc2047.el | 8 ++--- texi/ChangeLog | 1 + texi/gnus.texi | 9 +++-- texi/message.texi | 6 ++-- 12 files changed, 247 insertions(+), 66 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 296d269..0bb8429 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,64 @@ +Wed Dec 2 20:24:27 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.61 is released. + +1998-12-02 21:12:56 Lars Magne Ingebrigtsen + + * 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 + + * gnus.el: Pterodactyl Gnus v0.60 is released. + +1998-12-02 20:11:28 Lars Magne Ingebrigtsen + + * mml.el (mml-parse-1): Don't throw contents away. + +1998-12-02 Hrvoje Niksic + + * mml.el (mml-compute-boundary-1): Regexp-quote the boundary. + +1998-12-02 18:42:24 Lars Magne Ingebrigtsen + + * mml.el (mml-parse-singlepart-with-multiple-charsets): New + function. + (mml-parse-1): Use it. + +Tue Dec 1 23:04:25 1998 Shenghuo ZHU + + * 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 + + * 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 * gnus.el: Pterodactyl Gnus v0.59 is released. diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 67ea432..e6a757f 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -889,6 +889,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) @@ -1092,10 +1123,7 @@ If PROMPT (the prefix), prompt for a coding system to use." (defun article-decode-encoded-words () "Remove encoded-word encoding from headers." - (let ((inhibit-point-motion-hooks t) - buffer-read-only - (rfc2047-default-charset gnus-newsgroup-default-charset) - (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced)) + (let ((inhibit-point-motion-hooks t) buffer-read-only) (save-restriction (message-narrow-to-head) (funcall gnus-decode-header-function (point-min) (point-max))))) @@ -1975,6 +2003,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)))) ;;; @@ -3862,7 +3891,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 @@ -3878,7 +3907,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) diff --git a/lisp/gnus-picon.el b/lisp/gnus-picon.el index 11d0560..fe7caef 100644 --- a/lisp/gnus-picon.el +++ b/lisp/gnus-picon.el @@ -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) @@ -312,6 +308,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 @@ -338,27 +343,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)) @@ -420,7 +438,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 @@ -455,6 +474,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) @@ -717,7 +737,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"))) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index d01676a..77b9bd3 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -1006,7 +1006,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 diff --git a/lisp/gnus.el b/lisp/gnus.el index fb57c2a..015498e 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -254,7 +254,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "0.59" +(defconst gnus-version-number "0.61" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) diff --git a/lisp/message.el b/lisp/message.el index 429ecae..c957f49 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -1063,7 +1063,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." @@ -2018,6 +2019,7 @@ the user from the mailer." (let ((inhibit-read-only t)) (put-text-property (point-min) (point-max) 'read-only nil)) (message-fix-before-sending) + (message-encode-message-body) (run-hooks 'message-send-hook) (message "Sending...") (let ((alist message-send-method-alist) @@ -2107,7 +2109,6 @@ the user from the mailer." (case-fold-search nil) (news (message-news-p)) (mailbuf (current-buffer))) - (message-encode-message-body) (save-restriction (message-narrow-to-headers) ;; Insert some headers. @@ -2283,7 +2284,6 @@ to find out how to use this." result) (if (not (message-check-news-body-syntax)) nil - (message-encode-message-body) (save-restriction (message-narrow-to-headers) ;; Insert some headers. diff --git a/lisp/mm-uu.el b/lisp/mm-uu.el index e7d2e44..c0e8a26 100644 --- a/lisp/mm-uu.el +++ b/lisp/mm-uu.el @@ -2,7 +2,7 @@ ;; Copyright (c) 1998 by Shenghuo Zhu ;; Author: Shenghuo Zhu -;; $Revision: 1.1.1.5 $ +;; $Revision: 1.1.1.6 $ ;; Keywords: news postscript uudecode binhex shar ;; This file is not part of GNU Emacs, but the same permissions diff --git a/lisp/mml.el b/lisp/mml.el index f788a9e..5184ace 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -55,35 +55,100 @@ (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) @@ -100,13 +165,13 @@ (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 "=-=-=") @@ -149,7 +214,7 @@ (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)))) @@ -219,7 +284,8 @@ (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) @@ -246,7 +312,8 @@ (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) diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index 3484a04..47d1161 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -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))) diff --git a/texi/ChangeLog b/texi/ChangeLog index 700c4ad..6db832d 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,6 +1,7 @@ 1998-12-02 01:04:22 Lars Magne Ingebrigtsen * gnus.texi (Emacsen): Addition. + (Picon Useless Configuration): Addition. 1998-12-01 00:27:04 Lars Magne Ingebrigtsen diff --git a/texi/gnus.texi b/texi/gnus.texi index 64e2832..fb0d0f1 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Pterodactyl Gnus 0.59 Manual +@settitle Pterodactyl Gnus 0.61 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -318,7 +318,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Pterodactyl Gnus 0.59 Manual +@title Pterodactyl Gnus 0.61 Manual @author by Lars Magne Ingebrigtsen @page @@ -354,7 +354,7 @@ can be gotten by any nefarious means you can think of---@sc{nntp}, local spool or your mbox file. All at the same time, if you want to push your luck. -This manual corresponds to Pterodactyl Gnus 0.59. +This manual corresponds to Pterodactyl Gnus 0.61. @end ifinfo @@ -15581,6 +15581,9 @@ Ordered list of suffixes on picon file names to try. Defaults to Whether to move point to first empty line when displaying picons. This has only an effect if `gnus-picons-display-where' has value `article'. +If @code{nil}, display the picons in the @code{From} and +@code{Newsgroups} lines. This is the defailt. + @item gnus-picons-clear-cache-on-shutdown @vindex gnus-picons-clear-cache-on-shutdown Whether to clear the picons cache when exiting gnus. Gnus caches every diff --git a/texi/message.texi b/texi/message.texi index 68fb7e9..b9fac90 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Pterodactyl Message 0.59 Manual +@settitle Pterodactyl Message 0.61 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -42,7 +42,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Pterodactyl Message 0.59 Manual +@title Pterodactyl Message 0.61 Manual @author by Lars Magne Ingebrigtsen @page @@ -83,7 +83,7 @@ Message mode buffers. * Key Index:: List of Message mode keys. @end menu -This manual corresponds to Pterodactyl Message 0.59. Message is +This manual corresponds to Pterodactyl Message 0.61. Message is distributed with the Gnus distribution bearing the same version number as this manual. -- 1.7.10.4