+Thu Nov 19 04:48:42 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.51 is released.
+
+1998-11-19 04:02:34 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el: Applied patches from 5.6.45.
+
+ * gnus-score.el (gnus-score-find-trace): Print complete file
+ paths.
+ (gnus-score-find-trace): Truncate lines.
+
+ * gnus.el (gnus-message-archive-group): Allow function.
+
+ * message.el (message-encode-message-body): Remove Mime-Version
+ before inserting.
+
+ * gnus-cus.el (gnus-group-customize): Optional topic.
+
+ * gnus-sum.el (gnus-summary-customize-parameters): New command and
+ keystroke.
+
+Wed Nov 18 13:46:08 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-encode-message-body): Rewrite.
+
+1998-11-18 07:37:47 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mml.el (mml-base-boundary): New variable.
+ (mml-make-boundary): New function.
+
+ * gnus-cache.el (gnus-cache-coding-system): New variable.
+ (gnus-cache-request-article): Use it.
+
+ * message.el (message-insert-mime-part): Delete duplicates.
+
+Wed Nov 18 11:52:19 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-mime-display-alternative): Set end of
+ multipart and display even when nothing is preferred.
+
Wed Nov 18 05:06:44 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Pterodactyl Gnus v0.50 is released.
(ihandles handles)
(point (point))
handle buffer-read-only from props begend not-pref)
- (when preferred
- (save-restriction
- (when ibegend
- (narrow-to-region (car ibegend) (cdr ibegend))
- (delete-region (point-min) (point-max))
- (mm-remove-parts handles))
- (setq begend (list (point-marker)))
- ;; Do the toggle.
- (unless (setq not-pref (cadr (member preferred ihandles)))
- (setq not-pref (car ihandles)))
+ (save-restriction
+ (when ibegend
+ (narrow-to-region (car ibegend) (cdr ibegend))
+ (delete-region (point-min) (point-max))
+ (mm-remove-parts handles))
+ (setq begend (list (point-marker)))
+ ;; Do the toggle.
+ (unless (setq not-pref (cadr (member preferred ihandles)))
+ (setq not-pref (car ihandles)))
+ (gnus-add-text-properties
+ (setq from (point))
+ (progn
+ (insert (format "%d. " id))
+ (point))
+ `(gnus-callback
+ (lambda (handles)
+ (gnus-mime-display-alternative
+ ',ihandles ',not-pref
+ ',begend ,id))
+ local-map ,gnus-mime-button-map
+ ,gnus-mouse-face-prop ,gnus-article-mouse-face
+ face ,gnus-article-button-face
+ keymap ,gnus-mime-button-map
+ gnus-part ,id
+ gnus-data ,handle))
+ (widget-convert-button 'link from (point)
+ :action 'gnus-widget-press-button
+ :button-keymap gnus-widget-button-keymap)
+ ;; Do the handles
+ (while (setq handle (pop handles))
(gnus-add-text-properties
(setq from (point))
(progn
- (insert (format "%d. " id))
+ (insert (format "[%c] %-18s"
+ (if (equal handle preferred) ?* ? )
+ (if (stringp (car handle))
+ (car handle)
+ (car (mm-handle-type handle)))))
(point))
`(gnus-callback
(lambda (handles)
(gnus-mime-display-alternative
- ',ihandles ',not-pref
+ ',ihandles ',handle
',begend ,id))
local-map ,gnus-mime-button-map
,gnus-mouse-face-prop ,gnus-article-mouse-face
(widget-convert-button 'link from (point)
:action 'gnus-widget-press-button
:button-keymap gnus-widget-button-keymap)
- ;; Do the handles
- (while (setq handle (pop handles))
- (gnus-add-text-properties
- (setq from (point))
- (progn
- (insert (format "[%c] %-18s"
- (if (equal handle preferred) ?* ? )
- (if (stringp (car handle))
- (car handle)
- (car (mm-handle-type handle)))))
- (point))
- `(gnus-callback
- (lambda (handles)
- (gnus-mime-display-alternative
- ',ihandles ',handle
- ',begend ,id))
- local-map ,gnus-mime-button-map
- ,gnus-mouse-face-prop ,gnus-article-mouse-face
- face ,gnus-article-button-face
- keymap ,gnus-mime-button-map
- gnus-part ,id
- gnus-data ,handle))
- (widget-convert-button 'link from (point)
- :action 'gnus-widget-press-button
- :button-keymap gnus-widget-button-keymap)
- (insert " "))
- (insert "\n\n")
- (when preferred
- (if (stringp (car preferred))
- (gnus-display-mime preferred)
- (mm-display-part preferred)
- (goto-char (point-max))
- (setcdr begend (point-marker)))))
- (when ibegend
- (goto-char point)))))
+ (insert " "))
+ (insert "\n\n")
+ (when preferred
+ (if (stringp (car preferred))
+ (gnus-display-mime preferred)
+ (mm-display-part preferred)
+ (goto-char (point-max)))
+ (setcdr begend (point-marker))))
+ (when ibegend
+ (goto-char point))))
(defun gnus-article-wash-status ()
"Return a string which display status of article washing."
:type 'regexp)
(defcustom gnus-button-alist
- `(("<\\(url:[>\n\t ]*?\\)?news:[>\n\t ]*\\([^>\n\t ]*@[^)!;:,>\n\t ]*\\)>"
+ `(("<\\(url:[>\n\t ]*?\\)?news:[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>"
0 t gnus-button-message-id 2)
("\\bnews:\\([^>\n\t ]*@[^>)!;:,\n\t ]*\\)" 0 t gnus-button-message-id 1)
("\\(\\b<\\(url:[>\n\t ]*\\)?news:[>\n\t ]*\\(//\\)?\\([^>\n\t ]*\\)>\\)"
(defvar gnus-cache-overview-coding-system 'raw-text
"Coding system used on Gnus cache files.")
+(defvar gnus-cache-coding-system 'binary
+ "Coding system used on Gnus cache files.")
+
\f
;;; Internal variables.
(when (file-exists-p file)
(erase-buffer)
(gnus-kill-all-overlays)
- (nnheader-insert-file-contents file)
+ (let ((nnheader-file-coding-system gnus-cache-coding-system))
+ (nnheader-insert-file-contents file))
t)))
(defun gnus-cache-possibly-alter-active (group active)
;; Go through all the other files.
(while alphs
(when (and (file-directory-p (car alphs))
- (not (string-match "^\\.\\.?$"
+ (not (string-match "^\\."
(file-name-nondirectory (car alphs)))))
;; We descend directories.
(gnus-cache-generate-active (car alphs)))
(defvar gnus-custom-group)
(defvar gnus-custom-topic)
-(defun gnus-group-customize (group topic)
- "Edit the group or topicon the current line."
+(defun gnus-group-customize (group &optional topic)
+ "Edit the group or topic on the current line."
(interactive (list (gnus-group-group-name) (gnus-group-topic-name)))
(let (info
(types (mapcar (lambda (entry)
(mapatoms
(lambda (group)
(and (string-match regexp (symbol-value group))
- (gnus-active (symbol-name group))
(push (symbol-name group) groups)))
gnus-description-hashtb))
(if (not groups)
1 "No score rules apply to the current article (default score %d)."
gnus-summary-default-score)
(set-buffer "*Score Trace*")
+ (setq truncate-lines t)
(while trace
(insert (format "%S -> %s\n" (cdar trace)
- (if (caar trace)
- (file-name-nondirectory (caar trace))
- "(non-file rule)")))
+ (or (caar trace) "(non-file rule)")))
(setq trace (cdr trace)))
(goto-char (point-min))
(gnus-configure-windows 'score-trace)))
"\C-d" gnus-summary-enter-digest-group
"\M-\C-d" gnus-summary-read-document
"\M-\C-e" gnus-summary-edit-parameters
+ "\M-\C-g" gnus-summary-customize-parameters
"\C-c\C-b" gnus-bug
"*" gnus-cache-enter-article
"\M-*" gnus-cache-remove-article
["Edit local kill file" gnus-summary-edit-local-kill t]
["Edit main kill file" gnus-summary-edit-global-kill t]
["Edit group parameters" gnus-summary-edit-parameters t]
+ ["Customize group parameters" gnus-summary-customize-parameters t]
["Send a bug report" gnus-bug t]
("Exit"
["Catchup and exit" gnus-summary-catchup-and-exit t]
(interactive)
(gnus-group-edit-group gnus-newsgroup-name 'params))
+(defun gnus-summary-customize-parameters ()
+ "Customize the group parameters of the current group."
+ (interactive)
+ (gnus-group-customize gnus-newsgroup-name))
+
(defun gnus-summary-enter-digest-group (&optional force)
"Enter an nndoc group based on the current article.
If FORCE, force a digest interpretation. If not, try
(defconst gnus-product-name "T-gnus"
"Product name of this version of gnus.")
-(defconst gnus-version-number "6.10.036"
+(defconst gnus-version-number "6.10.037"
"Version number for this version of gnus.")
-(defconst gnus-original-version-number "0.50"
+(defconst gnus-original-version-number "0.51"
"Version number for this version of Gnus.")
(defconst gnus-original-product-name "Pterodactyl Gnus"
\"nnml+private:mail.misc\", for instance."
:group 'gnus-message
:type '(choice (const :tag "none" nil)
+ function
+ sexp
string))
(defcustom gnus-secondary-servers nil
("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers)
("rmailout" rmail-output rmail-output-to-rmail-file)
("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
- rmail-show-message)
+ rmail-show-message rmail-summary-exists
+ rmail-select-summary rmail-update-summary)
("gnus-audio" :interactive t gnus-audio-play)
("gnus-xmas" gnus-xmas-splash)
("gnus-soup" :interactive t
(list file
(completing-read
(format "MIME type for %s: " file)
- (mapcar (lambda (m) (list (cdr m))) mailcap-mime-extensions)
+ (delete-duplicates
+ (mapcar (lambda (m) (list (cdr m))) mailcap-mime-extensions))
nil nil type))))
(insert (format "<#part type=%s filename=\"%s\"><#/part>\n"
type file)))
(defun message-encode-message-body ()
- (message-goto-body)
- (save-restriction
- (narrow-to-region (point) (point-max))
- (let ((new (mml-generate-mime)))
- (delete-region (point-min) (point-max))
- (insert new)
- (goto-char (point-min))
- (widen)
- (forward-line -1)
- (let ((beg (point))
- (line (buffer-substring (point) (progn (forward-line 1) (point)))))
- (delete-region beg (point))
- (insert "Mime-Version: 1.0\n")
- (search-forward "\n\n")
- (forward-char -1)
- (insert line)
- (when (save-excursion
- (re-search-backward "^Content-Type: multipart/" nil t))
- (insert "This is a MIME multipart message. If you are reading\n")
- (insert "this, you shouldn't.\n"))))))
+ (let (lines multipart-p)
+ (message-goto-body)
+ (save-restriction
+ (narrow-to-region (point) (point-max))
+ (let ((new (mml-generate-mime)))
+ (delete-region (point-min) (point-max))
+ (insert new)
+ (goto-char (point-min))
+ (if (eq (aref new 0) ?\n)
+ (delete-char 1)
+ (search-forward "\n\n")
+ (setq lines (buffer-substring (point-min) (1- (point))))
+ (delete-region (point-min) (point)))))
+ (save-restriction
+ (message-narrow-to-headers-or-head)
+ (message-remove-header "Mime-Version")
+ (goto-char (point-max))
+ (insert "Mime-Version: 1.0\n")
+ (when lines
+ (insert lines))
+ (setq multipart-p
+ (re-search-backward "^Content-Type: multipart/" nil t)))
+ (when multipart-p
+ (message-goto-body)
+ (insert "This is a MIME multipart message. If you are reading\n")
+ (insert "this, you shouldn't.\n"))))
(defvar message-save-buffer " *encoding")
(defun message-save-drafts ()
;;; Code:
+(require 'mm-util)
+(require 'mm-bodies)
+(require 'mm-encode)
+
(defvar mml-syntax-table
(let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
(modify-syntax-entry ?\\ "/" table)
"Parse the current buffer as an MML document."
(let (struct)
(while (and (not (eobp))
- (not (looking-at "</#multipart")))
+ (not (looking-at "<#/multipart")))
(cond
((looking-at "<#multipart")
(push (nconc (mml-read-tag) (mml-parse-1)) struct))
(buffer-substring beg (goto-char (point-max))))))
(defvar mml-boundary nil)
+(defvar mml-base-boundary "=-=-=")
(defvar mml-multipart-number 0)
(defun mml-generate-mime ()
"Generate a MIME message based on the current MML document."
- (setq mml-boundary "-=-=")
(let ((cont (mml-parse))
(mml-multipart-number 0))
(with-temp-buffer
(defun mml-compute-boundary (cont)
"Return a unique boundary that does not exist in CONT."
- (let ((mml-boundary (concat (make-string (incf mml-multipart-number) ?=)
- mml-boundary)))
+ (let ((mml-boundary (mml-make-boundary)))
;; This function tries again and again until it has found
;; a unique boundary.
(while (not (catch 'not-unique
mml-boundary))
(defun mml-compute-boundary-1 (cont)
- (cond
- ((eq (car cont) 'part)
- (with-temp-buffer
- (if (setq filename (cdr (assq 'filename cont)))
- (insert-file-contents-literally filename)
- (insert (cdr (assq 'contents cont))))
- (goto-char (point-min))
- (when (re-search-forward (concat "^--" mml-boundary) nil t)
- (setq mml-boundary
- (concat (make-string (incf mml-multipart-number) ?=)
- mml-boundary))
- (throw 'not-unique nil))))
- ((eq (car cont) 'multipart)
- (mapcar 'mml-compute-boundary-1 (cddr cont))))
- t)
+ (let (filename)
+ (cond
+ ((eq (car cont) 'part)
+ (with-temp-buffer
+ (if (setq filename (cdr (assq 'filename cont)))
+ (insert-file-contents-literally filename)
+ (insert (cdr (assq 'contents cont))))
+ (goto-char (point-min))
+ (when (re-search-forward (concat "^--" mml-boundary) nil t)
+ (setq mml-boundary (mml-make-boundary))
+ (throw 'not-unique nil))))
+ ((eq (car cont) 'multipart)
+ (mapcar 'mml-compute-boundary-1 (cddr cont))))
+ t))
+
+(defun mml-make-boundary ()
+ (concat (mml-make-string (% (incf mml-multipart-number) 60) "=")
+ (if (> mml-multipart-number 17)
+ (format "%x" mml-multipart-number)
+ "")
+ mml-base-boundary))
+
+(defun mml-make-string (num string)
+ (let ((out ""))
+ (while (not (zerop (decf num)))
+ (setq out (concat out string)))
+ out))
(provide 'mml)
(deffoo nntp-request-group (group &optional server dont-check)
(nntp-possibly-change-group nil server)
- (when (nntp-send-command "^21.*\n" "GROUP" group)
+ (when (nntp-send-command "^[245].*\n" "GROUP" group)
(let ((entry (nntp-find-connection-entry nntp-server-buffer)))
(setcar (cddr entry) group))))
(set-buffer (process-buffer (car entry)))
(erase-buffer)
(nntp-send-string (car entry) (concat "GROUP " group))
- (nntp-wait-for-string "^2.*\n")
+ ;; allow for unexpected responses, since this can be called
+ ;; from a timer with quit inhibited
+ (nntp-wait-for-string "^[245].*\n")
(setcar (cddr entry) group)
(erase-buffer))))))
projects / elisp / gnus.git- / commitdiff