From: yamaoka Date: Mon, 22 Jan 2001 01:24:41 +0000 (+0000) Subject: Synch with Oort Gnus. X-Git-Tag: t-gnus-6_15_0-05-quimby~2 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=9f54864189aa44a4ff8c03fe39fc4b547bd7c061;p=elisp%2Fgnus.git- Synch with Oort Gnus. * texi/Makefile.in (.texi, %.info, %-ja.info, %-ja): Use `infohack-texi-format'. * texi/infohack: (infohack-texi-format): New function. * lisp/dgnushack.el (dgnushack-texi-format): Move to texi/infohack.el and rename. (dgnushack-texi-add-suffix-and-format): Remove. * texi/ptexinfmt.el: New file. * lisp/ptexinfmt.el: Move to texi/. --- diff --git a/ChangeLog b/ChangeLog index 45f9b78..695ff30 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,16 @@ +2001-01-22 Katsumi Yamaoka + + * texi/Makefile.in (.texi, %.info, %-ja.info, %-ja): Use + `infohack-texi-format'. + + * texi/infohack: (infohack-texi-format): New function. + * lisp/dgnushack.el (dgnushack-texi-format): Move to + texi/infohack.el and rename. + (dgnushack-texi-add-suffix-and-format): Remove. + + * texi/ptexinfmt.el: New file. + * lisp/ptexinfmt.el: Move to texi/. + 2001-01-18 Katsumi Yamaoka * lisp/gnus-vers.el (gnus-revision-number): Increment to 04. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 394182e..149c961 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,57 @@ +2001-01-21 12:00:00 ShengHuo ZHU + + * webmail.el (webmail-type-definition): netaddress changes. + +2001-01-21 00:00:00 ShengHuo ZHU + + * gnus.el: Fix copyright. Remove trailing spaces. + + * message.el (message-forward): Use mule4. + +2001-01-20 09:00:00 ShengHuo ZHU + + * mm-util.el (mm-string-as-unibyte): New. + + * message.el (message-forward): Use it. + +2001-01-19 23:00:00 ShengHuo ZHU + + * message.el (message-cite-original-without-signature): Don't peel + off the blank line. + (message-get-reply-headers): Add Cc if it is not in follow-to. + +2001-01-20 Simon Josefsson + + * mm-decode.el (mm-handle-multipart-from): Add. + (mm-dissect-buffer): Save From: header value. + (mm-security-from): Remove. + (mm-possibly-verify-or-decrypt): Don't set mm-security-from. + + * mml-smime.el (mml-smime-verify): Use `mm-handle-multipart-from' + instead of `mml-security-from'. Protect null from value. + +2001-01-20 Simon Josefsson + + * mailcap.el (mailcap-mime-data): Run `gnumeric' on + application/vnd.ms-excel attachments. + +2001-01-19 Simon Josefsson + + * gnus-art.el (gnus-button-alist): Add `?=' to mailto URL regexp. + +2001-01-19 13:00:00 ShengHuo ZHU + + * message.el (message-ignored-mail-headers): Ditto. + +2001-01-19 Simon Josefsson + + * message.el (message-ignored-news-headers): Only search beginning + of line. + +2001-01-19 Alberto Lusiani + + * message.el (message-send-mail): Content-Type may not be there. + 2001-01-18 23:00:00 ShengHuo ZHU * gnus-ems.el (gnus-article-display-xface): Add BUFFER. @@ -255,7 +309,7 @@ * nnfolder.el (nnfolder-existing-articles): Reversed, i.e. sorted. (nnfolder-request-expire-articles): Use gnus-sorted-intersection. (nnfolder-retrieve-headers): Use intersection. Suggested by Jonas - Kvarnstr,Av(Bm . + Kvarnstr,Av(Bm . 2000-12-30 00:17:38 Lars Magne Ingebrigtsen @@ -461,7 +515,7 @@ * message.el (message-forward): Save-restriction. -2000-12-21 Kai Gro,A_(Bjohann +2000-12-21 Kai Gro,A_(Bjohann * gnus-art.el (article-treat-dumbquotes): More doc, provided by Paul Stevenson @@ -1554,10 +1608,10 @@ * message.el (message-font-lock-keywords): use message-cite-prefix-regexp. -2000-11-15 Kai Gro,A_(Bjohann +2000-11-15 Kai Gro,A_(Bjohann * gnus-group.el (gnus-group-jump-to-group-prompt): New variable by - Stein Arild Str,Ax(Bmme. + Stein Arild Str,Ax(Bmme. (gnus-group-jump-to-group): Use it. (gnus-group-jump-to-group-prompt): Customize. @@ -1689,7 +1743,7 @@ * gnus-art.el (gnus-mime-display-alternative): Show button if no preferred part. -2000-11-07 Kai Gro,A_(Bjohann +2000-11-07 Kai Gro,A_(Bjohann * gnus-sum.el (gnus-move-split-methods): Say that `gnus-split-methods' uses file names, whereas this uses group diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el index b1e9496..7d9457f 100644 --- a/lisp/dgnushack.el +++ b/lisp/dgnushack.el @@ -1,5 +1,5 @@ ;;; dgnushack.el --- a hack to set the load path for byte-compiling -;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -247,7 +247,6 @@ Try to re-configure with --with-addpath=FLIM_PATH and run make again. (unless (featurep 'xemacs) (defalias 'Custom-make-dependencies 'ignore) (defalias 'update-autoloads-from-directory 'ignore)) -(autoload 'texinfo-parse-line-arg "texinfmt") (unless (fboundp 'with-temp-buffer) ;; Pickup some macros. @@ -261,7 +260,7 @@ Try to re-configure with --with-addpath=FLIM_PATH and run make again. (defalias 'define-mail-user-agent 'ignore) (defconst dgnushack-unexporting-files - (append '("dgnushack.el" "dgnuspath.el" "lpath.el" "ptexinfmt.el") + (append '("dgnushack.el" "dgnuspath.el" "lpath.el") (unless (or (condition-case code (require 'w3-forms) (error @@ -359,116 +358,6 @@ Modify to suit your needs.")) (byte-recompile-directory "." 0)) -(defun dgnushack-texi-add-suffix-and-format () - (dgnushack-texi-format t)) - -(defun dgnushack-texi-format (&optional addsuffix) - (if (not noninteractive) - (error "batch-texinfo-format may only be used -batch.")) - (require 'ptexinfmt) - (let ((auto-save-default nil) - (find-file-run-dired nil) - coding-system-for-write - output-coding-system) - (let ((error 0) - file - (files ())) - (while command-line-args-left - (setq file (expand-file-name (car command-line-args-left))) - (cond ((not (file-exists-p file)) - (message ">> %s does not exist!" file) - (setq error 1 - command-line-args-left (cdr command-line-args-left))) - ((file-directory-p file) - (setq command-line-args-left - (nconc (directory-files file nil nil t) - (cdr command-line-args-left)))) - (t - (setq files (cons file files) - command-line-args-left (cdr command-line-args-left))))) - (while (setq file (pop files)) - (condition-case err - (progn - (if buffer-file-name (kill-buffer (current-buffer))) - (find-file file) - (buffer-disable-undo (current-buffer)) - (if (boundp 'MULE) - (setq output-coding-system (symbol-value - 'file-coding-system)) - (setq coding-system-for-write buffer-file-coding-system)) - ;; Remove ignored areas first. - (while (re-search-forward "^@ignore[\t\r ]*$" nil t) - (delete-region (match-beginning 0) - (if (re-search-forward - "^@end[\t ]+ignore[\t\r ]*$" nil t) - (1+ (match-end 0)) - (point-max)))) - (goto-char (point-min)) - ;; Add suffix if it is needed. - (when (and addsuffix - (re-search-forward - "^@setfilename[\t ]+\\([^\t\n ]+\\)" nil t) - (not (string-match "\\.info$" (match-string 1)))) - (insert ".info") - (goto-char (point-min))) - ;; process @include before updating node - ;; This might produce some problem if we use @lowersection or - ;; such. - (let ((input-directory default-directory) - (texinfo-command-end)) - (while (re-search-forward "^@include" nil t) - (setq texinfo-command-end (point)) - (let ((filename (concat input-directory - (texinfo-parse-line-arg)))) - (re-search-backward "^@include") - (delete-region (point) (save-excursion - (forward-line 1) - (point))) - (message "Reading included file: %s" filename) - (save-excursion - (save-restriction - (narrow-to-region - (point) - (+ (point) - (car (cdr (insert-file-contents filename))))) - (goto-char (point-min)) - ;; Remove `@setfilename' line from included file, - ;; if any, so @setfilename command not duplicated. - (if (re-search-forward "^@setfilename" - (save-excursion - (forward-line 100) - (point)) - t) - (progn - (beginning-of-line) - (delete-region (point) (save-excursion - (forward-line 1) - (point)))))))))) - (texinfo-mode) - (texinfo-every-node-update) - (set-buffer-modified-p nil) - (message "texinfo formatting %s..." file) - (texinfo-format-buffer nil) - (if (buffer-modified-p) - (progn (message "Saving modified %s" (buffer-file-name)) - (save-buffer)))) - (error - (message ">> Error: %s" (prin1-to-string err)) - (message ">> point at") - (let ((s (buffer-substring (point) - (min (+ (point) 100) - (point-max)))) - (tem 0)) - (while (setq tem (string-match "\n+" s tem)) - (setq s (concat (substring s 0 (match-beginning 0)) - "\n>> " - (substring s (match-end 0))) - tem (1+ tem))) - (message ">> %s" s)) - (setq error 1)))) - (kill-emacs error)))) - - (defconst dgnushack-info-file-regexp-en (let ((names '("gnus" "message" "emacs-mime")) regexp name) diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 6cfba01..902d1b5 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -1,5 +1,6 @@ ;;; gnus-agent.el --- unplugged support for Semi-gnus -;; Copyright (C) 1997, 1998, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1998, 1999, 2000, 2001 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Tatsuya Ichikawa diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 104dbd1..c1a9b18 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -1,5 +1,6 @@ ;;; gnus-art.el --- article mode commands for Semi-gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -1391,7 +1392,7 @@ always hide." ((eq elem 'to-address) (let ((to (message-fetch-field "to")) (to-address - (gnus-group-find-parameter + (gnus-group-find-parameter (if (boundp 'gnus-newsgroup-name) gnus-newsgroup-name "") 'to-address))) (when (and to to-address @@ -1726,7 +1727,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (save-restriction (article-narrow-to-head) (when (and buffer-read-only ;; When type `W f' - (progn + (progn (goto-char (point-min)) (not (re-search-forward "^X-Face:[\t ]*" nil t))) (gnus-buffer-live-p gnus-original-article-buffer)) @@ -1737,7 +1738,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (setq x-faces (concat (or x-faces "") - (buffer-substring + (buffer-substring (match-beginning 0) (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t)))))))) @@ -5092,7 +5093,7 @@ after replacing with the original article." ("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 t gnus-button-message-id 3) ("\\( \n\t]+\\)>" 0 t gnus-url-mailto 2) - ("mailto:\\([-a-zA-Z.@_+0-9%]+\\)" 0 t gnus-url-mailto 1) + ("mailto:\\([-a-zA-Z.@_+0-9%=?]+\\)" 0 t gnus-url-mailto 1) ("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 1) ;; This is how URLs _should_ be embedded in text... ("]*\\)>" 0 t gnus-button-embedded-url 1) diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index 293b1e9..3a6a096 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -1,5 +1,5 @@ ;;; gnus-ems.el --- functions for making Semi-gnus work under different Emacsen -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 4b6dd49..6a4cfca 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -1,5 +1,5 @@ ;;; gnus-group.el --- group mode commands for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen diff --git a/lisp/gnus-mailcap.el b/lisp/gnus-mailcap.el index 209d69d..818b617 100644 --- a/lisp/gnus-mailcap.el +++ b/lisp/gnus-mailcap.el @@ -1,5 +1,5 @@ ;;; mailcap.el --- MIME media types configuration -;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. ;; Author: William M. Perry ;; Lars Magne Ingebrigtsen @@ -54,6 +54,10 @@ ;; files for the rest? -- fx (defvar mailcap-mime-data '(("application" + ("vnd.ms-excel" + (viewer . "gnumeric %s") + (test . (getenv "DISPLAY")) + (type . "application/vnd.ms-excel")) ("x-x509-ca-cert" (viewer . ssl-view-site-cert) (test . (fboundp 'ssl-view-site-cert)) @@ -306,7 +310,7 @@ If you are unsure what to do, please answer \"no\"." "Text of warning message displayed by `mailcap-maybe-eval'. Make sure that this text consists only of few text lines. Otherwise, Gnus might fail to display all of it.") - + (defun mailcap-maybe-eval () "Maybe evaluate a buffer of Emacs Lisp code." (let ((lisp-buffer (current-buffer))) diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 1d59c5d..90f4fec 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -1,5 +1,5 @@ ;;; gnus-msg.el --- mail and post interface for Semi-gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 ;; Free Software Foundation, Inc. ;; Author: Masanobu UMEDA @@ -439,7 +439,7 @@ If prefix argument YANK is non-nil, original article is yanked automatically." (gnus-copy-article-buffer) (let ((message-reply-buffer gnus-article-copy) - (message-reply-headers + (message-reply-headers (with-current-buffer gnus-article-copy ;; The headers are decoded. (nnheader-parse-head t)))) @@ -847,8 +847,8 @@ If FULL-HEADERS (the prefix), include full headers when forwarding." (defun gnus-summary-resend-message (address n) "Resend the current article to ADDRESS." - (interactive - (list (message-read-from-minibuffer "Resend message(s) to: ") + (interactive + (list (message-read-from-minibuffer "Resend message(s) to: ") current-prefix-arg)) (let ((articles (gnus-summary-work-articles n)) article) @@ -1224,7 +1224,7 @@ this is a reply." (concat "^" (regexp-quote mail-header-separator) "$") nil t) (replace-match "" t t )) - (unless (setq group-art + (unless (setq group-art (gnus-request-accept-article group method t t)) (gnus-message 1 "Couldn't store article in group %s: %s" group (gnus-status-message method)) @@ -1233,26 +1233,26 @@ this is a reply." (let ((active (gnus-active group))) (if active (if (< (cdr active) (cdr group-art)) - (gnus-set-active group (cons (car active) + (gnus-set-active group (cons (car active) (cdr group-art)))) (gnus-activate-group group))) (let ((buffer (gnus-summary-buffer-name group)) (mark gnus-read-mark) (article (cdr group-art))) - (unless - (and + (unless + (and (get-buffer buffer) (with-current-buffer buffer (when gnus-newsgroup-prepared (when (and gnus-newsgroup-auto-expire (memq mark gnus-auto-expirable-marks)) (setq mark gnus-expirable-mark)) - (setq mark (gnus-request-update-mark + (setq mark (gnus-request-update-mark group article mark)) (gnus-mark-article-as-read article mark) (setq gnus-newsgroup-active (gnus-active group)) t))) - (gnus-group-make-articles-read group + (gnus-group-make-articles-read group (list article)) (when (gnus-group-auto-expirable-p group) (gnus-add-marked-articles diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index 3294b22..eb5576e 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -1,5 +1,5 @@ ;;; gnus-topic.el --- a folding minor mode for Gnus group buffers -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 ;; Free Software Foundation, Inc. ;; Author: Ilja Weis diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 4baa25c..a1e42d6 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -1,5 +1,5 @@ ;;; gnus-util.el --- utility functions for Semi-gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -1043,7 +1043,7 @@ Entries without port tokens default to DEFAULTPORT." (property value start end properties &optional object) "Like `gnus-add-text-properties', only applied on where PROPERTY is VALUE." (let (point) - (while (and start + (while (and start (< start end) ;; XEmacs will loop for every when start=end. (setq point (text-property-not-all start end property value))) (gnus-add-text-properties start point properties object) @@ -1055,7 +1055,7 @@ Entries without port tokens default to DEFAULTPORT." (property value start end properties &optional object) "Like `remove-text-properties', only applied on where PROPERTY is VALUE." (let (point) - (while (and start + (while (and start (< start end) (setq point (text-property-not-all start end property value))) (remove-text-properties start point properties object) diff --git a/lisp/gnus-win.el b/lisp/gnus-win.el index 07e693e..de17928 100644 --- a/lisp/gnus-win.el +++ b/lisp/gnus-win.el @@ -1,5 +1,5 @@ ;;; gnus-win.el --- window configuration functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index 47955fb..2356458 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -1,7 +1,7 @@ ;;; gnus-xmas.el --- Gnus functions for XEmacs -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 -;; Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Katsumi Yamaoka diff --git a/lisp/gnus.el b/lisp/gnus.el index 850a316..28f7926 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -1,6 +1,6 @@ ;;; gnus.el --- a newsreader for GNU Emacs ;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, -;; 1997, 1998, 2000 Free Software Foundation, Inc. +;; 1997, 1998, 2000, 2001 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -916,7 +916,7 @@ REST is a plist of following: `(quote (repeat (list (regexp :tag "Group") ,parameter-type))))) (variable-default (plist-get rest :variable-default))) - (list + (list 'progn `(defcustom ,variable ,variable-default ,variable-document @@ -1474,7 +1474,7 @@ to be desirable; see the manual for further details." :type '(choice (const nil) integer)) -(gnus-define-group-parameter +(gnus-define-group-parameter auto-expire :type bool :function gnus-group-auto-expirable-p @@ -1489,17 +1489,17 @@ which to perform auto-expiry. This only makes sense for mail groups." :variable-group nnmail-expire :variable-type '(choice (const nil) regexp) - :parameter-type '(const :tag "Automatic Expire" t) - :parameter-document + :parameter-type '(const :tag "Automatic Expire" t) + :parameter-document "All articles that are read will be marked as expirable.") -(gnus-define-group-parameter +(gnus-define-group-parameter total-expire :type bool :function gnus-group-total-expirable-p :function-document "Check whether GROUP is total-expirable or not." - :variable gnus-total-expirable-newsgroups + :variable gnus-total-expirable-newsgroups :variable-default nil :variable-document "*Groups in which to perform expiry of all read articles. @@ -1510,8 +1510,8 @@ course.)" :variable-group nnmail-expire :variable-type '(choice (const nil) regexp) - :parameter-type '(const :tag "Total Expire" t) - :parameter-document + :parameter-type '(const :tag "Total Expire" t) + :parameter-document "All read articles will be put through the expiry process This happens even if they are not marked as expirable. @@ -2985,7 +2985,7 @@ Disallow invalid group names." (let ((prefix "") group) (while (not group) - (when (string-match + (when (string-match gnus-invalid-group-regexp (setq group (read-string (concat prefix prompt) (cons (or default "") 0) diff --git a/lisp/message.el b/lisp/message.el index cc3359c..8f7315d 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -1,5 +1,5 @@ ;;; message.el --- composing mail and news messages -*- coding: iso-latin-1 -*- -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -233,14 +233,14 @@ included. Organization, Lines and User-Agent are optional." :type 'sexp) (defcustom message-ignored-news-headers - "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|X-Draft-From:" + "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:" "*Regexp of headers to be removed unconditionally before posting." :group 'message-news :group 'message-headers :type 'regexp) (defcustom message-ignored-mail-headers - "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|X-Draft-From:" + "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:" "*Regexp of headers to be removed unconditionally before mailing." :group 'message-mail :group 'message-headers @@ -2600,7 +2600,10 @@ be added to \"References\" field. (while (looking-at "^[ \t]*$") (forward-line -1)) (forward-line 1) - (delete-region (point) end)) + (delete-region (point) end) + (unless (search-backward "\n\n" start t) + ;; Insert a blank line if it is peeled off. + (insert "\n"))) (goto-char start) (while functions (funcall (pop functions))) @@ -3105,8 +3108,9 @@ This sub function is for exclusive use of `message-send-mail'." (or (message-fetch-field "cc") (message-fetch-field "to")) (let ((ct (mime-read-Content-Type))) - (and (eq 'text (cdr (assq 'type ct))) - (eq 'plain (cdr (assq 'subtype ct))))))) + (or (not ct) + (and (eq 'text (cdr (assq 'type ct))) + (eq 'plain (cdr (assq 'subtype ct)))))))) (message-insert-courtesy-copy)) (setq failure (message-maybe-split-and-send-mail))) (kill-buffer tembuf)) @@ -4744,7 +4748,8 @@ that further discussion should take place only in " (progn (setq follow-to (list (cons 'To (or to-address mrt reply-to mft from)))) - (when (and wide mct) + (when (and wide (or mft mct) + (not (member (cons 'To (or mft mct)) follow-to))) (push (cons 'Cc mct) follow-to))) (let (ccalist) (save-excursion diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 22ba39b..fe50694 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -1,5 +1,5 @@ ;;; mm-decode.el --- Functions for decoding MIME things -;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -81,6 +81,8 @@ `(nth 7 ,handle)) (defmacro mm-handle-multipart-original-buffer (handle) `(get-text-property 0 'buffer (car ,handle))) +(defmacro mm-handle-multipart-from (handle) + `(get-text-property 0 'from (car ,handle))) (defmacro mm-handle-multipart-ctl-parameter (handle parameter) `(get-text-property 0 ,parameter (car ,handle))) @@ -181,7 +183,7 @@ "List of media types that are to be displayed inline." :type '(repeat string) :group 'mime-display) - + (defcustom mm-automatic-display '("text/plain" "text/enriched" "text/richtext" "text/html" "text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*" @@ -249,16 +251,16 @@ to: (defvar mm-verify-function-alist '(("application/pgp-signature" mml2015-verify "PGP" mml2015-verify-test) - ("application/x-gnus-pgp-signature" mm-uu-pgp-signed-extract-1 "PGP" + ("application/x-gnus-pgp-signature" mm-uu-pgp-signed-extract-1 "PGP" mm-uu-pgp-signed-test) - ("application/pkcs7-signature" mml-smime-verify "S/MIME" + ("application/pkcs7-signature" mml-smime-verify "S/MIME" mml-smime-verify-test) - ("application/x-pkcs7-signature" mml-smime-verify "S/MIME" + ("application/x-pkcs7-signature" mml-smime-verify "S/MIME" mml-smime-verify-test))) (defcustom mm-verify-option 'never "Option of verifying signed parts. -`never', not verify; `always', always verify; +`never', not verify; `always', always verify; `known', only verify known protocols. Otherwise, ask user." :type '(choice (item always) (item never) @@ -271,12 +273,12 @@ to: (defvar mm-decrypt-function-alist '(("application/pgp-encrypted" mml2015-decrypt "PGP" mml2015-decrypt-test) - ("application/x-gnus-pgp-encrypted" mm-uu-pgp-encrypted-extract-1 "PGP" + ("application/x-gnus-pgp-encrypted" mm-uu-pgp-encrypted-extract-1 "PGP" mm-uu-pgp-encrypted-test))) (defcustom mm-decrypt-option nil "Option of decrypting encrypted parts. -`never', not decrypt; `always', always decrypt; +`never', not decrypt; `always', always decrypt; `known', only decrypt known protocols. Otherwise, ask user." :type '(choice (item always) (item never) @@ -291,7 +293,7 @@ to: "Keymap for input viewer with completion.") ;; Should we bind other key to minibuffer-complete-word? -(define-key mm-viewer-completion-map " " 'self-insert-command) +(define-key mm-viewer-completion-map " " 'self-insert-command) (defvar mm-viewer-completion-map (let ((map (make-sparse-keymap 'mm-viewer-completion-map))) @@ -325,7 +327,7 @@ The original alist is not modified. See also `destructive-alist-to-plist'." (defun mm-dissect-buffer (&optional no-strict-mime) "Dissect the current buffer and return a list of MIME handles." (save-excursion - (let (ct ctl type subtype cte cd description id result) + (let (ct ctl type subtype cte cd description id result from) (save-restriction (mail-narrow-to-head) (when (or no-strict-mime @@ -335,6 +337,8 @@ The original alist is not modified. See also `destructive-alist-to-plist'." cte (mail-fetch-field "content-transfer-encoding") cd (mail-fetch-field "content-disposition") description (mail-fetch-field "content-description") + from (cadr (mail-extract-address-components + (or (mail-fetch-field "from") ""))) id (mail-fetch-field "content-id")))) (when cte (setq cte (mail-header-strip cte))) @@ -369,6 +373,9 @@ The original alist is not modified. See also `destructive-alist-to-plist'." (add-text-properties 0 (length (car ctl)) (list 'buffer (mm-copy-to-buffer)) (car ctl)) + (add-text-properties 0 (length (car ctl)) + (list 'from from) + (car ctl)) (cons (car ctl) (mm-dissect-multipart ctl)))) (t (mm-dissect-singlepart @@ -575,7 +582,7 @@ external if displayed external." (mm-handle-set-undisplayer handle (cons file buffer))) (message "Displaying %s..." (format method file)) 'external))))))) - + (defun mm-mailcap-command (method file type-list) (let ((ctl (cdr type-list)) (beg 0) @@ -964,7 +971,7 @@ external if displayed external." (and (mm-valid-image-format-p format) (mm-image-fit-p handle))) -(defun mm-find-part-by-type (handles type &optional notp recursive) +(defun mm-find-part-by-type (handles type &optional notp recursive) "Search in HANDLES for part with TYPE. If NOTP, returns first non-matching part. If RECURSIVE, search recursively." @@ -982,9 +989,9 @@ If RECURSIVE, search recursively." (setq handles (cdr handles))) handle)) -(defun mm-find-raw-part-by-type (ctl type &optional notp) +(defun mm-find-raw-part-by-type (ctl type &optional notp) (goto-char (point-min)) - (let* ((boundary (concat "--" (mm-handle-multipart-ctl-parameter ctl + (let* ((boundary (concat "--" (mm-handle-multipart-ctl-parameter ctl 'boundary))) (close-delimiter (concat "^" (regexp-quote boundary) "--[ \t]*$")) start @@ -1002,8 +1009,8 @@ If RECURSIVE, search recursively." (save-excursion (save-restriction (narrow-to-region start (1- (point))) - (when (let ((ctl (ignore-errors - (mail-header-parse-content-type + (when (let ((ctl (ignore-errors + (mail-header-parse-content-type (mail-fetch-field "content-type"))))) (if notp (not (equal (car ctl) type)) @@ -1015,8 +1022,8 @@ If RECURSIVE, search recursively." (save-excursion (save-restriction (narrow-to-region start end) - (when (let ((ctl (ignore-errors - (mail-header-parse-content-type + (when (let ((ctl (ignore-errors + (mail-header-parse-content-type (mail-fetch-field "content-type"))))) (if notp (not (equal (car ctl) type)) @@ -1025,26 +1032,20 @@ If RECURSIVE, search recursively." result)) (defvar mm-security-handle nil) -(defvar mm-security-from nil) (defsubst mm-set-handle-multipart-parameter (handle parameter value) ;; HANDLE could be a CTL. (if handle - (put-text-property 0 (length (car handle)) parameter value + (put-text-property 0 (length (car handle)) parameter value (car handle)))) (defun mm-possibly-verify-or-decrypt (parts ctl) (let ((subtype (cadr (split-string (car ctl) "/"))) (mm-security-handle ctl) ;; (car CTL) is the type. - (mm-security-from - (save-restriction - (mail-narrow-to-head) - (cadr (mail-extract-address-components - (or (mail-fetch-field "from") ""))))) protocol func functest) - (cond + (cond ((equal subtype "signed") - (unless (and (setq protocol + (unless (and (setq protocol (mm-handle-multipart-ctl-parameter ctl 'protocol)) (not (equal protocol "multipart/mixed"))) ;; The message is broken or draft-ietf-openpgp-multsig-01. @@ -1060,10 +1061,10 @@ If RECURSIVE, search recursively." (if (cond ((eq mm-verify-option 'never) nil) ((eq mm-verify-option 'always) t) - ((eq mm-verify-option 'known) - (and func - (or (not (setq functest - (nth 3 (assoc protocol + ((eq mm-verify-option 'known) + (and func + (or (not (setq functest + (nth 3 (assoc protocol mm-verify-function-alist)))) (funcall functest parts ctl)))) (t (y-or-n-p @@ -1073,16 +1074,16 @@ If RECURSIVE, search recursively." (save-excursion (if func (funcall func parts ctl) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details (format "Unknown sign protocol (%s)" protocol)))))) ((equal subtype "encrypted") - (unless (setq protocol + (unless (setq protocol (mm-handle-multipart-ctl-parameter ctl 'protocol)) ;; The message is broken. (let ((parts parts)) (while parts - (if (assoc (mm-handle-media-type (car parts)) + (if (assoc (mm-handle-media-type (car parts)) mm-decrypt-function-alist) (setq protocol (mm-handle-media-type (car parts)) parts nil) @@ -1092,20 +1093,20 @@ If RECURSIVE, search recursively." ((eq mm-decrypt-option 'never) nil) ((eq mm-decrypt-option 'always) t) ((eq mm-decrypt-option 'known) - (and func - (or (not (setq functest - (nth 3 (assoc protocol + (and func + (or (not (setq functest + (nth 3 (assoc protocol mm-decrypt-function-alist)))) (funcall functest parts ctl)))) - (t (y-or-n-p + (t (y-or-n-p (format "Decrypt (%s) part? " (or (nth 2 (assoc protocol mm-decrypt-function-alist)) (format "protocol=%s" protocol)))))) (save-excursion (if func (setq parts (funcall func parts ctl)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details (format "Unknown encrypt protocol (%s)" protocol)))))) (t nil)) parts)) diff --git a/lisp/mm-encode.el b/lisp/mm-encode.el index 134d67e..6baa7b7 100644 --- a/lisp/mm-encode.el +++ b/lisp/mm-encode.el @@ -1,5 +1,5 @@ ;;; mm-encode.el --- Functions for encoding MIME things -;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 0bb8bce..6c7d104 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -1,5 +1,5 @@ ;;; mm-util.el --- Utility functions for Mule and low level things -;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -37,7 +37,7 @@ (iso-8859-4 latin-iso8859-4) (iso-8859-5 cyrillic-iso8859-5) ;; Non-mule (X)Emacs uses the last mule-charset for 8bit characters. - ;; The fake mule-charset, gnus-koi8-r, tells Gnus that the default + ;; The fake mule-charset, gnus-koi8-r, tells Gnus that the default ;; charset is koi8-r, not iso-8859-5. (koi8-r cyrillic-iso8859-5 gnus-koi8-r) (iso-8859-6 arabic-iso8859-6) @@ -123,13 +123,14 @@ (aset string idx to)) (setq idx (1+ idx))) string))) + (string-as-unibyte . identity) ))) (eval-and-compile (defalias 'mm-char-or-char-int-p - (cond + (cond ((fboundp 'char-or-char-int-p) 'char-or-char-int-p) - ((fboundp 'char-valid-p) 'char-valid-p) + ((fboundp 'char-valid-p) 'char-valid-p) (t 'identity)))) (defvar mm-coding-system-list nil) @@ -155,7 +156,7 @@ "A mapping from invalid charset names to the real charset names.") (defvar mm-binary-coding-system - (cond + (cond ((mm-coding-system-p 'binary) 'binary) ((mm-coding-system-p 'no-conversion) 'no-conversion) (t nil)) @@ -172,10 +173,10 @@ "Text coding system for write.") (defvar mm-auto-save-coding-system - (cond + (cond ((mm-coding-system-p 'emacs-mule) (if (memq system-type '(windows-nt ms-dos ms-windows)) - (if (mm-coding-system-p 'emacs-mule-dos) + (if (mm-coding-system-p 'emacs-mule-dos) 'emacs-mule-dos mm-binary-coding-system) 'emacs-mule)) ((mm-coding-system-p 'escape-quoted) 'escape-quoted) @@ -291,9 +292,9 @@ If the charset is `composition', return the actual one." (progn (setq mail-parse-mule-charset (and (boundp 'current-language-environment) - (car (last - (assq 'charset - (assoc current-language-environment + (car (last + (assq 'charset + (assoc current-language-environment language-info-alist)))))) (if (or (not mail-parse-mule-charset) (eq mail-parse-mule-charset 'ascii)) @@ -431,8 +432,8 @@ Mule4 only." (let (charset) (setq charset (and (boundp 'current-language-environment) - (car (last (assq 'charset - (assoc current-language-environment + (car (last (assq 'charset + (assoc current-language-environment language-info-alist)))))) (if (eq charset 'ascii) (setq charset nil)) (or charset @@ -485,12 +486,12 @@ If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers. (after-insert-file-functions nil) (enable-local-eval nil) (find-file-hooks nil) - (inhibit-file-name-operation (if inhibit + (inhibit-file-name-operation (if inhibit 'insert-file-contents inhibit-file-name-operation)) (inhibit-file-name-handlers (if inhibit - (append mm-inhibit-file-name-handlers + (append mm-inhibit-file-name-handlers inhibit-file-name-handlers) inhibit-file-name-handlers))) (insert-file-contents filename visit beg end replace))) @@ -503,33 +504,33 @@ saying what text to write. Optional fourth argument specifies the coding system to use when encoding the file. If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers." - (let ((coding-system-for-write - (or codesys mm-text-coding-system-for-write + (let ((coding-system-for-write + (or codesys mm-text-coding-system-for-write mm-text-coding-system)) - (inhibit-file-name-operation (if inhibit + (inhibit-file-name-operation (if inhibit 'append-to-file inhibit-file-name-operation)) (inhibit-file-name-handlers (if inhibit - (append mm-inhibit-file-name-handlers + (append mm-inhibit-file-name-handlers inhibit-file-name-handlers) inhibit-file-name-handlers))) (append-to-file start end filename))) -(defun mm-write-region (start end filename &optional append visit lockname +(defun mm-write-region (start end filename &optional append visit lockname coding-system inhibit) "Like `write-region'. If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers." - (let ((coding-system-for-write - (or coding-system mm-text-coding-system-for-write + (let ((coding-system-for-write + (or coding-system mm-text-coding-system-for-write mm-text-coding-system)) - (inhibit-file-name-operation (if inhibit + (inhibit-file-name-operation (if inhibit 'write-region inhibit-file-name-operation)) (inhibit-file-name-handlers (if inhibit - (append mm-inhibit-file-name-handlers + (append mm-inhibit-file-name-handlers inhibit-file-name-handlers) inhibit-file-name-handlers))) (write-region start end filename append visit lockname))) diff --git a/lisp/mm-view.el b/lisp/mm-view.el index 0bf3f0c..11026f9 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -1,5 +1,5 @@ ;;; mm-view.el --- Functions for viewing MIME objects -;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. @@ -103,9 +103,9 @@ (and (boundp 'w3-meta-charset-content-type-regexp) (re-search-forward w3-meta-charset-content-type-regexp nil t))) - (setq charset (or (w3-coding-system-for-mime-charset - (buffer-substring-no-properties - (match-beginning 2) + (setq charset (or (w3-coding-system-for-mime-charset + (buffer-substring-no-properties + (match-beginning 2) (match-end 2))) charset))) (delete-region (point-min) (point-max)) @@ -158,7 +158,7 @@ (mm-handle-type handle) 'charset))) (if (or (eq charset 'gnus-decoded) ;; This is probably not entirely correct, but - ;; makes rfc822 parts with embedded multiparts work. + ;; makes rfc822 parts with embedded multiparts work. (eq mail-parse-charset 'gnus-decoded)) (save-restriction (narrow-to-region (point) (point)) @@ -215,8 +215,8 @@ (setq handles gnus-article-mime-handles)) (when handles (setq gnus-article-mime-handles - (nconc gnus-article-mime-handles - (if (listp (car handles)) + (nconc gnus-article-mime-handles + (if (listp (car handles)) handles (list handles)))))) (fundamental-mode) (goto-char (point-min))) @@ -237,8 +237,8 @@ (narrow-to-region b b) (mm-insert-part handle) (let (gnus-article-mime-handles - ;; disable prepare hook - gnus-article-prepare-hook + ;; disable prepare hook + gnus-article-prepare-hook (gnus-newsgroup-charset (or charset gnus-newsgroup-charset))) (run-hooks 'gnus-article-decode-hook) @@ -253,8 +253,8 @@ (insert "----------\n\n") (when handles (setq gnus-article-mime-handles - (nconc gnus-article-mime-handles - (if (listp (car handles)) + (nconc gnus-article-mime-handles + (if (listp (car handles)) handles (list handles))))) (mm-handle-set-undisplayer handle diff --git a/lisp/mml-smime.el b/lisp/mml-smime.el index 7ebc439..46db906 100644 --- a/lisp/mml-smime.el +++ b/lisp/mml-smime.el @@ -1,5 +1,5 @@ ;;; mml-smime.el --- S/MIME support for MML -;; Copyright (c) 2000 Free Software Foundation, Inc. +;; Copyright (c) 2000, 2001 Free Software Foundation, Inc. ;; Author: Simon Josefsson ;; Keywords: Gnus, MIME, S/MIME, MML @@ -77,7 +77,7 @@ (smime-get-key-by-email (completing-read "Sign this part with what signature? " smime-keys nil nil - (and (listp (car-safe smime-keys)) + (and (listp (car-safe smime-keys)) (caar smime-keys)))))))) (defun mml-smime-get-file-cert () @@ -93,7 +93,7 @@ (while (not result) (setq who (read-from-minibuffer (format "%sLookup certificate for: " (or bad "")) - (cadr (funcall gnus-extract-address-components + (cadr (funcall gnus-extract-address-components (or (save-excursion (save-restriction (message-narrow-to-headers) @@ -124,9 +124,9 @@ (insert-buffer (mm-handle-multipart-original-buffer ctl)) (goto-char (point-min)) (insert (format "Content-Type: %s; " (mm-handle-media-type ctl))) - (insert (format "protocol=\"%s\"; " + (insert (format "protocol=\"%s\"; " (mm-handle-multipart-ctl-parameter ctl 'protocol))) - (insert (format "micalg=\"%s\"; " + (insert (format "micalg=\"%s\"; " (mm-handle-multipart-ctl-parameter ctl 'micalg))) (insert (format "boundary=\"%s\"\n\n" (mm-handle-multipart-ctl-parameter ctl 'boundary))) @@ -142,12 +142,12 @@ (if (not good-signature) (progn ;; we couldn't verify message, fail with openssl output as message - (mm-set-handle-multipart-parameter + (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "Failed") (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details - (concat "OpenSSL failed to verify message:\n" - "---------------------------------\n" + mm-security-handle 'gnus-details + (concat "OpenSSL failed to verify message:\n" + "---------------------------------\n" openssl-output))) ;; verify mail addresses in mail against those in certificate (when (and (smime-pkcs7-region (point-min) (point-max)) @@ -161,23 +161,23 @@ (point-min) (point)) addresses))) (delete-region (point-min) (point))) (setq addresses (mapcar 'downcase addresses)))) - (if (not (member (downcase mm-security-from) addresses)) - (mm-set-handle-multipart-parameter + (if (not (member (downcase (or (mm-handle-multipart-from ctl) "")) addresses)) + (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "Sender address forged") (if good-certificate - (mm-set-handle-multipart-parameter + (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "Ok (sender authenticated)") (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "Integrity OK (sender unknown)"))) (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details - (concat "Sender clamed to be: " mm-security-from "\n" + mm-security-handle 'gnus-details + (concat "Sender clamed to be: " (mm-handle-multipart-from ctl) "\n" (if addresses - (concat "Addresses in certificate: " + (concat "Addresses in certificate: " (mapconcat 'identity addresses ", ")) "No addresses found in certificate. (Requires OpenSSL 0.9.6 or later.)") - "\n" "\n" - "OpenSSL output:\n" + "\n" "\n" + "OpenSSL output:\n" "---------------\n" openssl-output "\n" "Certificate(s) inside S/MIME signature:\n" "---------------------------------------\n" diff --git a/lisp/mml.el b/lisp/mml.el index de23d5f..87f2ec3 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -1,5 +1,5 @@ ;;; mml.el --- A package for parsing and validating MML documents -;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. @@ -40,7 +40,7 @@ (defvar mml-generate-multipart-alist nil "*Alist of multipart generation functions. Each entry has the form (NAME . FUNCTION), where -NAME is a string containing the name of the part (without the +NAME is a string containing the name of the part (without the leading \"/multipart/\"), FUNCTION is a Lisp function which is called to generate the part. @@ -78,7 +78,7 @@ one charsets.") (defvar mml-buffer-list nil) -(defun mml-generate-new-buffer (name) +(defun mml-generate-new-buffer (name) (let ((buf (generate-new-buffer name))) (push buf mml-buffer-list) buf)) @@ -121,7 +121,7 @@ one charsets.") (setq raw (cdr (assq 'raw tag)) point (point) contents (mml-read-part (eq 'mml (car tag))) - charsets (if raw nil + charsets (if raw nil (mm-find-mime-charset-region point (point)))) (when (and (not raw) (memq nil charsets)) (if (or (memq 'unknown-encoding mml-confirmation-set) @@ -130,7 +130,7 @@ one charsets.") Message contains characters with unknown encoding. Really send?") (set (make-local-variable 'mml-confirmation-set) (push 'unknown-encoding mml-confirmation-set)))) - (if (setq use-ascii + (if (setq use-ascii (or (memq 'use-ascii mml-confirmation-set) (y-or-n-p "Use ASCII as charset?"))) (setq charsets (delq nil charsets)) @@ -162,7 +162,7 @@ A message part needs to be split into %d charset parts. Really send? " (forward-line 1)) (nreverse struct))) -(defun mml-parse-singlepart-with-multiple-charsets +(defun mml-parse-singlepart-with-multiple-charsets (orig-tag beg end &optional use-ascii) (save-excursion (save-restriction @@ -258,7 +258,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (if (re-search-forward "<#\\(/\\)?mml." nil t) (setq count (+ count (if (match-beginning 1) -1 1))) (goto-char (point-max)))) - (buffer-substring-no-properties beg (if (> count 0) + (buffer-substring-no-properties beg (if (> count 0) (point) (match-beginning 0)))) (if (re-search-forward @@ -291,7 +291,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (buffer-string))))) (defun mml-generate-mime-1 (cont) - (let ((mm-use-ultra-safe-encoding + (let ((mm-use-ultra-safe-encoding (or mm-use-ultra-safe-encoding (assq 'sign cont)))) (save-restriction (narrow-to-region (point) (point)) @@ -303,7 +303,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (if (and (not raw) (member (car (split-string type "/")) '("text" "message"))) (with-temp-buffer - (setq charset (mm-charset-to-coding-system + (setq charset (mm-charset-to-coding-system (cdr (assq 'charset cont)))) (when (eq charset 'ascii) (setq charset nil)) @@ -327,7 +327,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." nil t) (delete-region (+ (match-beginning 0) 2) (+ (match-beginning 0) 3)))))) - (cond + (cond ((eq (car cont) 'mml) (let ((mml-boundary (funcall mml-boundary-function (incf mml-multipart-number))) @@ -340,7 +340,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b"))) ;; ignore 0x1b, it is part of iso-2022-jp (setq encoding (mm-body-7-or-8)))) - (t + (t (setq charset (mm-encode-body charset)) (setq encoding (mm-body-encoding charset (cdr (assq 'encoding cont)))))) @@ -382,7 +382,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (concat "access-type=" (if (member (nth 0 name) '("ftp@" "anonymous@")) "anon-ftp" - "ftp"))))) + "ftp"))))) (when url (mml-insert-parameter (mail-header-encode-parameter "url" url) @@ -599,7 +599,7 @@ If HANDLES is non-nil, use it instead reparsing the buffer." (save-excursion (set-buffer (setq buffer (mml-generate-new-buffer " *mml*"))) (mm-insert-part handle) - (if (setq mmlp (equal (mm-handle-media-type handle) + (if (setq mmlp (equal (mm-handle-media-type handle) "message/rfc822")) (mime-to-mml))))) (if mmlp @@ -608,7 +608,7 @@ If HANDLES is non-nil, use it instead reparsing the buffer." (equal (mm-handle-media-type handle) "text/plain")) (mml-insert-mml-markup handle buffer textp))) (cond - (mmlp + (mmlp (insert-buffer buffer) (goto-char (point-max)) (insert "<#/mml>\n")) @@ -863,7 +863,7 @@ If RAW, don't highlight the article." (interactive "P") (let ((buf (current-buffer)) (message-options message-options) - (message-posting-charset (or (gnus-setup-posting-charset + (message-posting-charset (or (gnus-setup-posting-charset (save-restriction (message-narrow-to-headers-or-head) (message-fetch-field "Newsgroups"))) diff --git a/lisp/mml2015.el b/lisp/mml2015.el index 0b49560..8a56946 100644 --- a/lisp/mml2015.el +++ b/lisp/mml2015.el @@ -1,5 +1,5 @@ ;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP) -;; Copyright (C) 2000 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu ;; Keywords: PGP MIME MML @@ -28,7 +28,7 @@ (eval-when-compile (require 'cl)) (require 'mm-decode) -(defvar mml2015-use (or +(defvar mml2015-use (or (progn (ignore-errors (require 'gpg)) @@ -49,7 +49,7 @@ mml2015-mailcrypt-verify mml2015-mailcrypt-decrypt mml2015-mailcrypt-clear-verify - mml2015-mailcrypt-clear-decrypt) + mml2015-mailcrypt-clear-decrypt) (gpg mml2015-gpg-sign mml2015-gpg-encrypt mml2015-gpg-verify @@ -80,32 +80,32 @@ (defun mml2015-mailcrypt-decrypt (handle ctl) (catch 'error (let (child handles result) - (unless (setq child (mm-find-part-by-type - (cdr handle) + (unless (setq child (mm-find-part-by-type + (cdr handle) "application/octet-stream" nil t)) - (mm-set-handle-multipart-parameter + (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "Corrupted") (throw 'error handle)) (with-temp-buffer (mm-insert-part child) - (setq result + (setq result (condition-case err (funcall mml2015-decrypt-function) - (error - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details (cadr err)) + (error + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details (cadr err)) nil) (quit - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details "Quit.") + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details "Quit.") nil))) (unless (car result) - (mm-set-handle-multipart-parameter + (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "Failed") (throw 'error handle)) (setq handles (mm-dissect-buffer t))) (mm-destroy-parts handle) - (mm-set-handle-multipart-parameter + (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "OK") (if (listp (car handles)) handles @@ -113,21 +113,21 @@ (defun mml2015-mailcrypt-clear-decrypt () (let (result) - (setq result + (setq result (condition-case err (funcall mml2015-decrypt-function) - (error - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details (cadr err)) + (error + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details (cadr err)) nil) (quit - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details "Quit.") + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details "Quit.") nil))) (if (car result) - (mm-set-handle-multipart-parameter + (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "OK") - (mm-set-handle-multipart-parameter + (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "Failed")))) (defun mml2015-fix-micalg (alg) @@ -139,19 +139,19 @@ (defun mml2015-mailcrypt-verify (handle ctl) (catch 'error (let (part) - (unless (setq part (mm-find-raw-part-by-type - ctl (or (mm-handle-multipart-ctl-parameter + (unless (setq part (mm-find-raw-part-by-type + ctl (or (mm-handle-multipart-ctl-parameter ctl 'protocol) "application/pgp-signature") t)) - (mm-set-handle-multipart-parameter + (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "Corrupted") (throw 'error handle)) (with-temp-buffer (insert "-----BEGIN PGP SIGNED MESSAGE-----\n") - (insert (format "Hash: %s\n\n" + (insert (format "Hash: %s\n\n" (or (mml2015-fix-micalg - (mm-handle-multipart-ctl-parameter + (mm-handle-multipart-ctl-parameter ctl 'micalg)) "SHA1"))) (save-restriction @@ -162,9 +162,9 @@ (if (looking-at "^-") (insert "- ")) (forward-line))) - (unless (setq part (mm-find-part-by-type + (unless (setq part (mm-find-part-by-type (cdr handle) "application/pgp-signature" nil t)) - (mm-set-handle-multipart-parameter + (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "Corrupted") (throw 'error handle)) (save-restriction @@ -177,41 +177,41 @@ (replace-match "-----END PGP SIGNATURE-----" t t))) (unless (condition-case err (funcall mml2015-verify-function) - (error - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details (cadr err)) + (error + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details (cadr err)) nil) (quit - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details "Quit.") + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details "Quit.") nil)) - (mm-set-handle-multipart-parameter + (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "Failed") (throw 'error handle))) - (mm-set-handle-multipart-parameter + (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "OK") handle))) (defun mml2015-mailcrypt-clear-verify () (if (condition-case err (funcall mml2015-verify-function) - (error - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details (cadr err)) + (error + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details (cadr err)) nil) (quit - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details "Quit.") + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details "Quit.") nil)) - (mm-set-handle-multipart-parameter + (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "OK") - (mm-set-handle-multipart-parameter + (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "Failed"))) (defun mml2015-mailcrypt-sign (cont) (mc-sign-generic (message-options-get 'message-sender) nil nil nil nil) - (let ((boundary + (let ((boundary (funcall mml-boundary-function (incf mml-multipart-number))) hash point) (goto-char (point-min)) @@ -237,7 +237,7 @@ (error "Cannot find signature part." )) (replace-match "-----END PGP MESSAGE-----" t t) (goto-char (match-beginning 0)) - (unless (re-search-backward "^-----BEGIN PGP SIGNATURE-----\r?$" + (unless (re-search-backward "^-----BEGIN PGP SIGNATURE-----\r?$" nil t) (error "Cannot find signature part." )) (replace-match "-----BEGIN PGP MESSAGE-----" t t) @@ -258,23 +258,23 @@ (let ((mc-pgp-always-sign (or mc-pgp-always-sign (eq t (or (message-options-get 'message-sign-encrypt) - (message-options-set + (message-options-set 'message-sign-encrypt (or (y-or-n-p "Sign the message? ") 'not)))) 'never))) (mm-with-unibyte-current-buffer-mule4 - (mc-encrypt-generic + (mc-encrypt-generic (or (message-options-get 'message-recipients) (message-options-set 'message-recipients - (mc-cleanup-recipient-headers + (mc-cleanup-recipient-headers (read-string "Recipients: ")))) nil nil nil (message-options-get 'message-sender)))) (goto-char (point-min)) (unless (looking-at "-----BEGIN PGP MESSAGE-----") (error "Fail to encrypt the message.")) - (let ((boundary + (let ((boundary (funcall mml-boundary-function (incf mml-multipart-number)))) (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n" boundary)) @@ -306,10 +306,10 @@ (let ((cipher (current-buffer)) plain result) (if (with-temp-buffer (prog1 - (gpg-decrypt cipher (setq plain (current-buffer)) + (gpg-decrypt cipher (setq plain (current-buffer)) mml2015-result-buffer nil) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details (with-current-buffer mml2015-result-buffer (buffer-string))) (set-buffer cipher) @@ -329,20 +329,20 @@ (let (result) (setq result (mml2015-gpg-decrypt-1)) (if (car result) - (mm-set-handle-multipart-parameter + (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "OK") - (mm-set-handle-multipart-parameter + (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "Failed")))) (defun mml2015-gpg-verify (handle ctl) (catch 'error (let (part message signature) - (unless (setq part (mm-find-raw-part-by-type - ctl (or (mm-handle-multipart-ctl-parameter + (unless (setq part (mm-find-raw-part-by-type + ctl (or (mm-handle-multipart-ctl-parameter ctl 'protocol) "application/pgp-signature") t)) - (mm-set-handle-multipart-parameter + (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "Corrupted") (throw 'error handle)) (with-temp-buffer @@ -350,31 +350,31 @@ (insert part) (with-temp-buffer (setq signature (current-buffer)) - (unless (setq part (mm-find-part-by-type + (unless (setq part (mm-find-part-by-type (cdr handle) "application/pgp-signature" nil t)) - (mm-set-handle-multipart-parameter + (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "Corrupted") (throw 'error handle)) (mm-insert-part part) (unless (condition-case err (prog1 (gpg-verify message signature mml2015-result-buffer) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details (with-current-buffer mml2015-result-buffer (buffer-string)))) - (error - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details (cadr err)) + (error + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details (cadr err)) nil) (quit - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details "Quit.") + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details "Quit.") nil)) - (mm-set-handle-multipart-parameter + (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "Failed") (throw 'error handle))) - (mm-set-handle-multipart-parameter + (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "OK")) handle))) @@ -382,25 +382,25 @@ (if (condition-case err (prog1 (gpg-verify-cleartext (current-buffer) mml2015-result-buffer) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details (with-current-buffer mml2015-result-buffer (buffer-string)))) - (error - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details (cadr err)) + (error + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details (cadr err)) nil) (quit - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details "Quit.") + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details "Quit.") nil)) - (mm-set-handle-multipart-parameter + (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "OK") - (mm-set-handle-multipart-parameter + (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "Failed"))) (defun mml2015-gpg-sign (cont) - (let ((boundary + (let ((boundary (funcall mml-boundary-function (incf mml-multipart-number))) (text (current-buffer)) signature) (goto-char (point-max)) @@ -408,7 +408,7 @@ (insert "\n")) (with-temp-buffer (unless (gpg-sign-detached text (setq signature (current-buffer)) - mml2015-result-buffer + mml2015-result-buffer nil (message-options-get 'message-sender) t t) ; armor & textmode @@ -434,17 +434,17 @@ (goto-char (point-max))))) (defun mml2015-gpg-encrypt (cont) - (let ((boundary + (let ((boundary (funcall mml-boundary-function (incf mml-multipart-number))) (text (current-buffer)) cipher) (mm-with-unibyte-current-buffer-mule4 (with-temp-buffer - (unless (gpg-sign-encrypt + (unless (gpg-sign-encrypt text (setq cipher (current-buffer)) - mml2015-result-buffer + mml2015-result-buffer (split-string - (or + (or (message-options-get 'message-recipients) (message-options-set 'message-recipients (read-string "Recipients: "))) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 1510d4a..c26f018 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -1,5 +1,5 @@ ;;; nnmail.el --- mail support functions for the Gnus mail backends -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -325,7 +325,7 @@ the following: GROUP: Mail will be stored in GROUP (a string). \(FIELD VALUE [- RESTRICT [- RESTRICT [...]]] SPLIT): If the message - field FIELD (a regexp) contains VALUE (a regexp), store the messages + field FIELD (a regexp) contains VALUE (a regexp), store the messages as specified by SPLIT. If RESTRICT (a regexp) matches some string after FIELD and before the end of the matched VALUE, return NIL, otherwise process SPLIT. Multiple RESTRICTs add up, further @@ -373,12 +373,12 @@ Example: (any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\") (any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\") ;; Both lists below have the same suffix, so prevent - ;; cross-posting to mkpkg.list of messages posted only to + ;; cross-posting to mkpkg.list of messages posted only to ;; the bugs- list, but allow cross-posting when the ;; message was really cross-posted. (any \"bugs-mypackage@somewhere\" \"mypkg.bugs\") (any \"mypackage@somewhere\" - \"bugs-mypackage\" \"mypkg.list\") - ;; + ;; ;; People... (any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\")) ;; Unmatched mail goes to the catch all group. diff --git a/lisp/nnslashdot.el b/lisp/nnslashdot.el index 4fcb011..cd628a8 100644 --- a/lisp/nnslashdot.el +++ b/lisp/nnslashdot.el @@ -1,5 +1,5 @@ ;;; nnslashdot.el --- interfacing with Slashdot -;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -156,7 +156,7 @@ "by ]+>\\([^<]+\\)[ \t\n]*.*(\\([^)]+\\))") (progn (goto-char (- (match-end 0) 5)) - (setq from (concat + (setq from (concat (nnweb-decode-entities-string (match-string 1)) " <" (match-string 2) ">"))) (setq from "") @@ -184,7 +184,7 @@ (concat subject " (" score ")") from date (concat "<" (nnslashdot-sid-strip sid) "%" - (number-to-string (1+ article)) + (number-to-string (1+ article)) "@slashdot>") (if parent (concat "<" (nnslashdot-sid-strip sid) "%" @@ -258,7 +258,7 @@ "by ]+>\\([^<]+\\)[ \t\n]*.*(\\([^)]+\\))") (progn (goto-char (- (match-end 0) 5)) - (setq from (concat + (setq from (concat (nnweb-decode-entities-string (match-string 1)) " <" (match-string 2) ">"))) (setq from "") @@ -285,7 +285,7 @@ (1+ article) (concat subject " (" score ")") from date (concat "<" (nnslashdot-sid-strip sid) "%" - (number-to-string (1+ article)) + (number-to-string (1+ article)) "@slashdot>") (if parent (concat "<" (nnslashdot-sid-strip sid) "%" @@ -386,7 +386,7 @@ sid elem description articles gname) (condition-case why ;; First we do the Ultramode to get info on all the latest groups. - (progn + (progn (mm-with-unibyte-buffer (nnweb-insert "http://slashdot.org/slashdot.xml" t) (goto-char (point-min)) @@ -432,7 +432,7 @@ (nnslashdot-write-groups) (nnslashdot-generate-active) t)) - + (deffoo nnslashdot-request-newgroups (date &optional server) (nnslashdot-possibly-change-server nil server) (nnslashdot-generate-active) @@ -520,7 +520,7 @@ (defun nnslashdot-write-groups () (with-temp-file (expand-file-name "groups" nnslashdot-directory) (prin1 nnslashdot-groups (current-buffer)))) - + (defun nnslashdot-init (server) "Initialize buffers and such." (unless (file-exists-p nnslashdot-directory) diff --git a/lisp/nnvirtual.el b/lisp/nnvirtual.el index abf2cf5..0880a2b 100644 --- a/lisp/nnvirtual.el +++ b/lisp/nnvirtual.el @@ -1,5 +1,5 @@ ;;; nnvirtual.el --- virtual newsgroups access for Gnus -;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001 ;; Free Software Foundation, Inc. ;; Author: David Moore @@ -363,7 +363,7 @@ component group will show up when you enter the virtual group.") (gnus-request-post (gnus-find-method-for-group group))))) -(deffoo nnvirtual-request-expire-articles (articles group +(deffoo nnvirtual-request-expire-articles (articles group &optional server force) (nnvirtual-possibly-change-server server) (setq nnvirtual-component-groups diff --git a/lisp/pop3.el b/lisp/pop3.el index b8bc546..238b116 100644 --- a/lisp/pop3.el +++ b/lisp/pop3.el @@ -1,6 +1,6 @@ ;;; pop3.el --- Post Office Protocol (RFC 1460) interface -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 ;; Free Software Foundation, Inc. ;; Author: Richard L. Pieri diff --git a/lisp/ptexinfmt.el b/lisp/ptexinfmt.el deleted file mode 100644 index 036c97b..0000000 --- a/lisp/ptexinfmt.el +++ /dev/null @@ -1,759 +0,0 @@ -;;; ptexinfmt.el -- portable Texinfo formatter. - -;; Copyright (C) 1985, 1986, 1988, 1990, 1991, 1992, 1993, -;; 1994, 1995, 1996, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1999 Yoshiki Hayashi -;; Copyright (C) 2000 TAKAHASHI Kaoru - -;; Author: TAKAHASHI Kaoru -;; Yoshiki Hayashi -;; Maintainer: TAKAHASHI Kaoru -;; Created: 7 Jul 2000 -;; Keywords: maint, tex, docs, emulation, compatibility - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. - -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; Original code: Yoshiki Hayashi -;; makeinfo.el (gnujdoc project) - -;; Support texinfmt.el 2.32 or later. - -;;; Code: -(require 'texinfmt) -(require 'poe) -(require 'broken) - -(provide 'ptexinfmt) - -;;; Broken -(defvar ptexinfmt-disable-broken-notice-flag t - "If non-nil disable notice, when call `broken-facility'. -This is NO-NOTICE argument in `broken-facility'.") - -;; sort -fd -(broken-facility texinfo-format-printindex - "Can't sort on Mule for Windows." - (if (and (memq system-type '(windows-nt ms-dos)) -;;; I don't know version threshold. -;;; (string< texinfmt-version "2.37 of 24 May 1997") - (boundp 'MULE) (not (featurep 'meadow))) ; Mule for Windows - nil - t) - ptexinfmt-disable-broken-notice-flag) - -;; @var -(broken-facility texinfo-format-var - "Don't perse @var argument." - (condition-case nil - (with-temp-buffer - (let (texinfo-enclosure-list texinfo-alias-list) - (texinfo-mode) - (insert "@var{@asis{foo}}\n") - (texinfo-format-expand-region (point-min) (point-max)) - t)) - (error nil)) - ptexinfmt-disable-broken-notice-flag) - -;; @xref -(broken-facility texinfo-format-xref - "Can't format @xref, 1st argument is empty." - (condition-case nil - (with-temp-buffer - (let (texinfo-enclosure-list texinfo-alias-list) - (texinfo-mode) - (insert "@xref{, xref, , file}\n") - (texinfo-format-expand-region (point-min) (point-max)) - t)) - (error nil)) - ptexinfmt-disable-broken-notice-flag) - -;; @uref -(broken-facility texinfo-format-uref - "Parse twice @uref argument." - (condition-case nil - (with-temp-buffer - (let (texinfo-enclosure-list texinfo-alias-list) - (texinfo-mode) - (insert "@uref{mailto:foo@@bar.com}\n") - (texinfo-format-expand-region (point-min) (point-max)) - t)) - (error nil)) - ptexinfmt-disable-broken-notice-flag) - -;; @multitable -(broken-facility texinfo-multitable-widths - "`texinfo-multitable-widths' unsupport wide-char." - (if (fboundp 'texinfo-multitable-widths) - (with-temp-buffer - (let ((str "$BI}9-J8;z(B")) - (texinfo-mode) - (insert (format " {%s}\n" str)) - (goto-char (point-min)) - (if (= (car (texinfo-multitable-widths)) (length str)) - nil - t))) - ;; function definition is void - t) - ptexinfmt-disable-broken-notice-flag) - -(broken-facility texinfo-multitable-item - "`texinfo-multitable-item' unsupport wide-char." - (if-broken texinfo-multitable-widths nil t) - ptexinfmt-disable-broken-notice-flag) - - -;;; Obsolete -;; Removed Texinfo 3.8 -(put 'overfullrule 'texinfo-format 'texinfo-discard-line) -(put 'smallbreak 'texinfo-format 'texinfo-discard-line) -(put 'medbreak 'texinfo-format 'texinfo-discard-line) -(put 'bigbreak 'texinfo-format 'texinfo-discard-line) -;; Removed Texinfo 3.9 -(put 'setchapterstyle 'texinfo-format 'texinfo-discard-line-with-args) - -;;; Hardcopy and HTML (discard) -;; I18N -(put 'documentlanguage 'texinfo-format 'texinfo-discard-line-with-args) -(put 'documentencoding 'texinfo-format 'texinfo-discard-line-with-args) - -;; size -(put 'smallbook 'texinfo-format 'texinfo-discard-line) -(put 'afourpaper 'texinfo-format 'texinfo-discard-line) -(put 'afourlatex 'texinfo-format 'texinfo-discard-line) -(put 'afourwide 'texinfo-format 'texinfo-discard-line) -(put 'pagesizes 'texinfo-format 'texinfo-discard-line-with-args) - -;; style -(put 'setchapternewpage 'texinfo-format 'texinfo-discard-line-with-args) -(put 'kbdinputstyle 'texinfo-format 'texinfo-discard-line-with-args) - -;; flags -(put 'setcontentsaftertitlepage 'texinfo-format 'texinfo-discard-line) -(put 'setshortcontentsaftertitlepage 'texinfo-format 'texinfo-discard-line) -(put 'novalidate 'texinfo-format 'texinfo-discard-line-with-args) - -;; head & foot -(put 'headings 'texinfo-format 'texinfo-discard-line-with-args) -(put 'evenfooting 'texinfo-format 'texinfo-discard-line-with-args) -(put 'evenheading 'texinfo-format 'texinfo-discard-line-with-args) -(put 'oddfooting 'texinfo-format 'texinfo-discard-line-with-args) -(put 'oddheading 'texinfo-format 'texinfo-discard-line-with-args) -(put 'everyfooting 'texinfo-format 'texinfo-discard-line-with-args) -(put 'everyheading 'texinfo-format 'texinfo-discard-line-with-args) - -;; misc -(put 'page 'texinfo-format 'texinfo-discard-line) -(put 'hyphenation 'texinfo-format 'texinfo-discard-command-and-arg) - - - -;;; Directory File -;; @direcategory -(put 'dircategory 'texinfo-format 'texinfo-format-dircategory) -(defun-maybe texinfo-format-dircategory () - (let ((str (texinfo-parse-arg-discard))) - (delete-region (point) - (progn - (skip-chars-forward " ") - (point))) - (insert "INFO-DIR-SECTION " str "\n"))) - -;; @direntry -(put 'direntry 'texinfo-format 'texinfo-format-direntry) -(defun-maybe texinfo-format-direntry () - (texinfo-push-stack 'direntry nil) - (texinfo-discard-line) - (insert "START-INFO-DIR-ENTRY\n")) - -(put 'direntry 'texinfo-end 'texinfo-end-direntry) -(defun-maybe texinfo-end-direntry () - (texinfo-discard-command) - (insert "END-INFO-DIR-ENTRY\n\n") - (texinfo-pop-stack 'direntry)) - - -;;; Block Enclosing and Conditional -;; @detailmenu ... @end detailmenu -(put 'detailmenu 'texinfo-format 'texinfo-discard-line) -(put 'detailmenu 'texinfo-end 'texinfo-discard-command) - -;; @smalldisplay ... @end smalldisplay -(put 'smalldisplay 'texinfo-format 'texinfo-format-example) -(put 'smalldisplay 'texinfo-end 'texinfo-end-example) - -;; @smallformat ... @end smallformat -(put 'smallformat 'texinfo-format 'texinfo-format-flushleft) -(put 'smallformat 'texinfo-end 'texinfo-end-flushleft) - -;; @ifnottex ... @end ifnottex -(put 'ifnottex 'texinfo-format 'texinfo-discard-line) -(put 'ifnottex 'texinfo-end 'texinfo-discard-command) - -;; @ifnothtml ... @end ifnothtml -(put 'ifnothtml 'texinfo-format 'texinfo-discard-line) -(put 'ifnothtml 'texinfo-end 'texinfo-discard-command) - -;; @ifnotinfo ... @end ifnotinfo -(put 'ifnotinfo 'texinfo-format 'texinfo-format-ifnotinfo) -(put 'endifnotinfo 'texinfo-format 'texinfo-discard-line) -(defun-maybe texinfo-format-ifnotinfo () - (delete-region texinfo-command-start - (progn (re-search-forward "@end ifnotinfo[ \t]*\n") - (point)))) - -;; @html ... @end html -(put 'html 'texinfo-format 'texinfo-format-html) -(put 'endhtml 'texinfo-format 'texinfo-discard-line) -(defun-maybe texinfo-format-html () - (delete-region texinfo-command-start - (progn (re-search-forward "@end html[ \t]*\n") - (point)))) - - - -;;; Marking -;; @url, @env, @command -(put 'url 'texinfo-format 'texinfo-format-code) -(put 'env 'texinfo-format 'texinfo-format-code) -(put 'command 'texinfo-format 'texinfo-format-code) - -;; @acronym -(put 'acronym 'texinfo-format 'texinfo-format-var) - -(when-broken texinfo-format-var - (fmakunbound 'texinfo-format-var)) -(defun-maybe texinfo-format-var () - (let ((arg (texinfo-parse-expanded-arg))) - (texinfo-discard-command) - (insert (upcase arg)))) - -;; @key -(put 'key 'texinfo-format 'texinfo-format-key) -(defun-maybe texinfo-format-key () - (insert (texinfo-parse-arg-discard)) - (goto-char texinfo-command-start)) - -;; @email{EMAIL-ADDRESS[, DISPLAYED-TEXT]} -(put 'email 'texinfo-format 'texinfo-format-email) -(defun-maybe texinfo-format-email () - "Format EMAIL-ADDRESS and optional DISPLAYED-TXT. -Insert < ... > around EMAIL-ADDRESS." - (let ((args (texinfo-format-parse-args))) - (texinfo-discard-command) - ;; if displayed-text - (if (nth 1 args) - (insert (nth 1 args) " <" (nth 0 args) ">") - (insert "<" (nth 0 args) ">")))) - -;; @option -(put 'option 'texinfo-format 'texinfo-format-option) -(defun texinfo-format-option () - "Insert ` ... ' around arg unless inside a table; in that case, no quotes." - ;; `looking-at-backward' not available in v. 18.57, 20.2 - ;; searched-for character is a control-H - (if (not (search-backward "\010" - (save-excursion (beginning-of-line) (point)) - t)) - (insert "`" (texinfo-parse-arg-discard) "'") - (insert (texinfo-parse-arg-discard))) - (goto-char texinfo-command-start)) - - - -;;; Accents and Special characters -;; @pounds{} ==> # Pounds Sterling -(put 'pounds 'texinfo-format 'texinfo-format-pounds) -(defun-maybe texinfo-format-pounds () - (texinfo-parse-arg-discard) - (insert "#")) - -;; @OE{} ==> OE French-OE-ligature -(put 'OE 'texinfo-format 'texinfo-format-French-OE-ligature) -(defun-maybe texinfo-format-French-OE-ligature () - (insert "OE" (texinfo-parse-arg-discard)) - (goto-char texinfo-command-start)) - -;; @oe{} ==> oe -(put 'oe 'texinfo-format 'texinfo-format-French-oe-ligature) -(defun-maybe texinfo-format-French-oe-ligature () ; lower case - (insert "oe" (texinfo-parse-arg-discard)) - (goto-char texinfo-command-start)) - -;; @AA{} ==> AA Scandinavian-A-with-circle -(put 'AA 'texinfo-format 'texinfo-format-Scandinavian-A-with-circle) -(defun-maybe texinfo-format-Scandinavian-A-with-circle () - (insert "AA" (texinfo-parse-arg-discard)) - (goto-char texinfo-command-start)) - -;; @aa{} ==> aa -(put 'aa 'texinfo-format 'texinfo-format-Scandinavian-a-with-circle) -(defun-maybe texinfo-format-Scandinavian-a-with-circle () ; lower case - (insert "aa" (texinfo-parse-arg-discard)) - (goto-char texinfo-command-start)) - -;; @AE{} ==> AE Latin-Scandinavian-AE -(put 'AE 'texinfo-format 'texinfo-format-Latin-Scandinavian-AE) -(defun-maybe texinfo-format-Latin-Scandinavian-AE () - (insert "AE" (texinfo-parse-arg-discard)) - (goto-char texinfo-command-start)) - -;; @ae{} ==> ae -(put 'ae 'texinfo-format 'texinfo-format-Latin-Scandinavian-ae) -(defun-maybe texinfo-format-Latin-Scandinavian-ae () ; lower case - (insert "ae" (texinfo-parse-arg-discard)) - (goto-char texinfo-command-start)) - -;; @ss{} ==> ss German-sharp-S -(put 'ss 'texinfo-format 'texinfo-format-German-sharp-S) -(defun-maybe texinfo-format-German-sharp-S () - (insert "ss" (texinfo-parse-arg-discard)) - (goto-char texinfo-command-start)) - -;; @questiondown{} ==> ? upside-down-question-mark -(put 'questiondown 'texinfo-format 'texinfo-format-upside-down-question-mark) -(defun-maybe texinfo-format-upside-down-question-mark () - (insert "?" (texinfo-parse-arg-discard)) - (goto-char texinfo-command-start)) - -;; @exclamdown{} ==> ! upside-down-exclamation-mark -(put 'exclamdown 'texinfo-format 'texinfo-format-upside-down-exclamation-mark) -(defun-maybe texinfo-format-upside-down-exclamation-mark () - (insert "!" (texinfo-parse-arg-discard)) - (goto-char texinfo-command-start)) - -;; @L{} ==> L/ Polish suppressed-L (Lslash) -(put 'L 'texinfo-format 'texinfo-format-Polish-suppressed-L) -(defun-maybe texinfo-format-Polish-suppressed-L () - (insert (texinfo-parse-arg-discard) "/L") - (goto-char texinfo-command-start)) - -;; @l{} ==> l/ Polish suppressed-L (Lslash) (lower case) -(put 'l 'texinfo-format 'texinfo-format-Polish-suppressed-l-lower-case) -(defun-maybe texinfo-format-Polish-suppressed-l-lower-case () - (insert (texinfo-parse-arg-discard) "/l") - (goto-char texinfo-command-start)) - -;; @O{} ==> O/ Scandinavian O-with-slash -(put 'O 'texinfo-format 'texinfo-format-Scandinavian-O-with-slash) -(defun-maybe texinfo-format-Scandinavian-O-with-slash () - (insert (texinfo-parse-arg-discard) "O/") - (goto-char texinfo-command-start)) - -;; @o{} ==> o/ Scandinavian O-with-slash (lower case) -(put 'o 'texinfo-format 'texinfo-format-Scandinavian-o-with-slash-lower-case) -(defun-maybe texinfo-format-Scandinavian-o-with-slash-lower-case () - (insert (texinfo-parse-arg-discard) "o/") - (goto-char texinfo-command-start)) - -;; @,{c} ==> c, cedilla accent -(put ', 'texinfo-format 'texinfo-format-cedilla-accent) -(defun-maybe texinfo-format-cedilla-accent () - (insert (texinfo-parse-arg-discard) ",") - (goto-char texinfo-command-start)) - - -;; @dotaccent{o} ==> .o overdot-accent -(put 'dotaccent 'texinfo-format 'texinfo-format-overdot-accent) -(defun-maybe texinfo-format-overdot-accent () - (insert "." (texinfo-parse-arg-discard)) - (goto-char texinfo-command-start)) - -;; @ubaraccent{o} ==> _o underbar-accent -(put 'ubaraccent 'texinfo-format 'texinfo-format-underbar-accent) -(defun-maybe texinfo-format-underbar-accent () - (insert "_" (texinfo-parse-arg-discard)) - (goto-char texinfo-command-start)) - -;; @udotaccent{o} ==> o-. underdot-accent -(put 'udotaccent 'texinfo-format 'texinfo-format-underdot-accent) -(defun-maybe texinfo-format-underdot-accent () - (insert (texinfo-parse-arg-discard) "-.") - (goto-char texinfo-command-start)) - -;; @H{o} ==> ""o long Hungarian umlaut -(put 'H 'texinfo-format 'texinfo-format-long-Hungarian-umlaut) -(defun-maybe texinfo-format-long-Hungarian-umlaut () - (insert "\"\"" (texinfo-parse-arg-discard)) - (goto-char texinfo-command-start)) - -;; @ringaccent{o} ==> *o ring accent -(put 'ringaccent 'texinfo-format 'texinfo-format-ring-accent) -(defun-maybe texinfo-format-ring-accent () - (insert "*" (texinfo-parse-arg-discard)) - (goto-char texinfo-command-start)) - -;; @tieaccent{oo} ==> [oo tie after accent -(put 'tieaccent 'texinfo-format 'texinfo-format-tie-after-accent) -(defun-maybe texinfo-format-tie-after-accent () - (insert "[" (texinfo-parse-arg-discard)) - (goto-char texinfo-command-start)) - -;; @u{o} ==> (o breve accent -(put 'u 'texinfo-format 'texinfo-format-breve-accent) -(defun-maybe texinfo-format-breve-accent () - (insert "(" (texinfo-parse-arg-discard)) - (goto-char texinfo-command-start)) - -;; @v{o} ==> i dotless i and dotless j -(put 'dotless 'texinfo-format 'texinfo-format-dotless) -(defun-maybe texinfo-format-dotless () - (insert (texinfo-parse-arg-discard)) - (goto-char texinfo-command-start)) - - - -;;; Cross References -;; @ref, @xref -(put 'ref 'texinfo-format 'texinfo-format-xref) - -(when-broken texinfo-format-xref - (fmakunbound 'texinfo-format-xref)) -(defun-maybe texinfo-format-xref () - (let ((args (texinfo-format-parse-args))) - (texinfo-discard-command) - (insert "*Note ") - (let ((fname (or (nth 1 args) (nth 2 args)))) - (if (null (or fname (nth 3 args))) - (insert (nth 0 args) "::") - (insert (or fname (nth 0 args)) ": ") - (if (nth 3 args) - (insert "(" (nth 3 args) ")")) - (unless (null (nth 0 args)) - (insert (nth 0 args))))))) - -;; @uref -(put 'uref 'texinfo-format 'texinfo-format-uref) -(when-broken texinfo-format-uref - (fmakunbound 'texinfo-format-uref)) -(defun-maybe texinfo-format-uref () - "Format URL and optional URL-TITLE. -Insert ` ... ' around URL if no URL-TITLE argument; -otherwise, insert URL-TITLE followed by URL in parentheses." - (let ((args (texinfo-format-parse-args))) - (texinfo-discard-command) - ;; if url-title - (if (nth 1 args) - (insert (nth 1 args) " (" (nth 0 args) ")") - (insert "`" (nth 0 args) "'")))) - - - -;;; New command definition -;; @alias NEW=EXISTING -(put 'alias 'texinfo-format 'texinfo-alias) -(defun-maybe texinfo-alias () - (let ((start (1- (point))) - args) - (skip-chars-forward " ") - (save-excursion (end-of-line) (setq texinfo-command-end (point))) - (if (not (looking-at "\\([^=]+\\)=\\(.*\\)")) - (error "Invalid alias command") - (setq texinfo-alias-list - (cons - (cons - (buffer-substring (match-beginning 1) (match-end 1)) - (buffer-substring (match-beginning 2) (match-end 2))) - texinfo-alias-list)) - (texinfo-discard-command)))) - -;; @definfoenclose NEWCMD, BEFORE, AFTER - - - -;;; Special -;; @image{FILENAME, [WIDTH], [HEIGHT]} -(put 'image 'texinfo-format 'texinfo-format-image) -(defun-maybe texinfo-format-image () - (let ((args (texinfo-format-parse-args)) ; parse FILENAME? - filename) - (when (null (nth 0 args)) - (error "Invalid image command")) - (texinfo-discard-command) - ;; makeinfo uses FILENAME.txt - (setq filename (format "%s.txt" (nth 0 args))) - (message "Reading included file: %s" filename) - ;; verbatim for Info output - (goto-char (+ (point) (cadr (insert-file-contents filename)))) - (message "Reading included file: %s...done" filename))) - - -;; @exampleindent - - - -;;; @multitable ... @end multitable -(defvar-maybe texinfo-extra-inter-column-width 0 - "*Number of extra spaces between entries (columns) in @multitable.") - -(defvar-maybe texinfo-multitable-buffer-name "*multitable-temporary-buffer*") -(defvar-maybe texinfo-multitable-rectangle-name "texinfo-multitable-temp-") - -;; These commands are defined in texinfo.tex for printed output. -(put 'multitableparskip 'texinfo-format 'texinfo-discard-line-with-args) -(put 'multitableparindent 'texinfo-format 'texinfo-discard-line-with-args) -(put 'multitablecolmargin 'texinfo-format 'texinfo-discard-line-with-args) -(put 'multitablelinespace 'texinfo-format 'texinfo-discard-line-with-args) - -(put 'multitable 'texinfo-format 'texinfo-multitable) - -(defun-maybe texinfo-multitable () - "Produce multi-column tables." - -;; This function pushes information onto the `texinfo-stack'. -;; A stack element consists of: -;; - type-of-command, i.e., multitable -;; - the information about column widths, and -;; - the position of texinfo-command-start. -;; e.g., ('multitable (1 2 3 4) 123) -;; The command line is then deleted. - (texinfo-push-stack - 'multitable - ;; push width information on stack - (texinfo-multitable-widths)) - (texinfo-discard-line-with-args)) - -(put 'multitable 'texinfo-end 'texinfo-end-multitable) -(defun-maybe texinfo-end-multitable () - "Discard the @end multitable line and pop the stack of multitable." - (texinfo-discard-command) - (texinfo-pop-stack 'multitable)) - -(when-broken texinfo-multitable-widths - (fmakunbound 'texinfo-multitable-widths)) - -(defun-maybe texinfo-multitable-widths () - "Return list of widths of each column in a multi-column table." - (let (texinfo-multitable-width-list) - ;; Fractions format: - ;; @multitable @columnfractions .25 .3 .45 - ;; - ;; Template format: - ;; @multitable {Column 1 template} {Column 2} {Column 3 example} - ;; Place point before first argument - (skip-chars-forward " \t") - (cond - ;; Check for common misspelling - ((looking-at "@columnfraction ") - (error "In @multitable, @columnfractions misspelled")) - ;; Case 1: @columnfractions .25 .3 .45 - ((looking-at "@columnfractions") - (forward-word 1) - (while (not (eolp)) - (setq texinfo-multitable-width-list - (cons - (truncate - (1- - (* fill-column (read (get-buffer (current-buffer)))))) - texinfo-multitable-width-list)))) - ;; - ;; Case 2: {Column 1 template} {Column 2} {Column 3 example} - ((looking-at "{") - (let ((start-of-templates (point))) - (while (not (eolp)) - (skip-chars-forward " \t") - (let* ((start-of-template (1+ (point))) - (end-of-template - ;; forward-sexp works with braces in Texinfo mode - (progn (forward-sexp 1) (1- (point))))) - (setq texinfo-multitable-width-list - (cons (- (progn (goto-char end-of-template) (current-column)) - (progn (goto-char start-of-template) (current-column))) - texinfo-multitable-width-list)) - ;; Remove carriage return from within a template, if any. - ;; This helps those those who want to use more than - ;; one line's worth of words in @multitable line. - (narrow-to-region start-of-template end-of-template) - (goto-char (point-min)) - (while (search-forward " -" nil t) - (delete-char -1)) - (goto-char (point-max)) - (widen) - (forward-char 1))))) - ;; - ;; Case 3: Trouble - (t - (error - "You probably need to specify column widths for @multitable correctly"))) - ;; Check whether columns fit on page. - (let ((desired-columns - (+ - ;; between column spaces - (length texinfo-multitable-width-list) - ;; additional between column spaces, if any - texinfo-extra-inter-column-width - ;; sum of spaces for each entry - (apply '+ texinfo-multitable-width-list)))) - (if (> desired-columns fill-column) - (error - (format - "Multi-column table width, %d chars, is greater than page width, %d chars." - desired-columns fill-column)))) - texinfo-multitable-width-list)) - -;; @item A1 @tab A2 @tab A3 -(defun-maybe texinfo-multitable-extract-row () - "Return multitable row, as a string. -End of row is beginning of next @item or beginning of @end. -Cells within rows are separated by @tab." - (skip-chars-forward " \t") - (let* ((start (point)) - (end (progn - (re-search-forward "@item\\|@end") - (match-beginning 0))) - (row (progn (goto-char end) - (skip-chars-backward " ") - ;; remove whitespace at end of argument - (delete-region (point) end) - (buffer-substring start (point))))) - (delete-region texinfo-command-start end) - row)) - -(when-broken texinfo-multitable-item - (fmakunbound 'texinfo-multitable-item)) - -(put 'multitable 'texinfo-item 'texinfo-multitable-item) -(defun-maybe texinfo-multitable-item () - "Format a row within a multicolumn table. -Cells in row are separated by @tab. -Widths of cells are specified by the arguments in the @multitable line. -All cells are made to be the same height. -This command is executed when texinfmt sees @item inside @multitable." - (let ((original-buffer (current-buffer)) - (table-widths (reverse (car (cdr (car texinfo-stack))))) - (existing-fill-column fill-column) - start - end - (table-column 0) - (table-entry-height 0) - ;; unformatted row looks like: A1 @tab A2 @tab A3 - ;; extract-row command deletes the source line in the table. - (unformated-row (texinfo-multitable-extract-row))) - ;; Use a temporary buffer - (set-buffer (get-buffer-create texinfo-multitable-buffer-name)) - (delete-region (point-min) (point-max)) - (insert unformated-row) - (goto-char (point-min)) -;; 1. Check for correct number of @tab in line. - (let ((tab-number 1)) ; one @tab between two columns - (while (search-forward "@tab" nil t) - (setq tab-number (1+ tab-number))) - (if (/= tab-number (length table-widths)) - (error "Wrong number of @tab's in a @multitable row"))) - (goto-char (point-min)) -;; 2. Format each cell, and copy to a rectangle - ;; buffer looks like this: A1 @tab A2 @tab A3 - ;; Cell #1: format up to @tab - ;; Cell #2: format up to @tab - ;; Cell #3: format up to eob - (while (not (eobp)) - (setq start (point)) - (setq end (save-excursion - (if (search-forward "@tab" nil 'move) - ;; Delete the @tab command, including the @-sign - (delete-region - (point) - (progn (forward-word -1) (1- (point))))) - (point))) - ;; Set fill-column *wider* than needed to produce inter-column space - (setq fill-column (+ 1 - texinfo-extra-inter-column-width - (nth table-column table-widths))) - (narrow-to-region start end) - ;; Remove whitespace before and after entry. - (skip-chars-forward " ") - (delete-region (point) (save-excursion (beginning-of-line) (point))) - (goto-char (point-max)) - (skip-chars-backward " ") - (delete-region (point) (save-excursion (end-of-line) (point))) - ;; Temorarily set texinfo-stack to nil so texinfo-format-scan - ;; does not see an unterminated @multitable. - (let (texinfo-stack) ; nil - (texinfo-format-scan)) - (let (fill-prefix) ; no fill prefix - (fill-region (point-min) (point-max))) - (setq table-entry-height - (max table-entry-height (count-lines (point-min) (point-max)))) -;; 3. Move point to end of bottom line, and pad that line to fill column. - (goto-char (point-min)) - (forward-line (1- table-entry-height)) - (let* ((beg (point)) ; beginning of line - ;; add one more space for inter-column spacing - (needed-whitespace - (1+ - (- fill-column - (progn (end-of-line) (current-column)))))) ; end of existing line - (insert (make-string - (if (> needed-whitespace 0) needed-whitespace 1) - ? ))) - ;; now, put formatted cell into a rectangle - (set (intern (concat texinfo-multitable-rectangle-name - (int-to-string table-column))) - (extract-rectangle (point-min) (point))) - (delete-region (point-min) (point)) - (goto-char (point-max)) - (setq table-column (1+ table-column)) - (widen)) -;; 4. Add extra lines to rectangles so all are of same height - (let ((total-number-of-columns table-column) - (column-number 0) - here) - (while (> table-column 0) - (let ((this-rectangle (int-to-string table-column))) - (while (< (length this-rectangle) table-entry-height) - (setq this-rectangle (append this-rectangle '(""))))) - (setq table-column (1- table-column))) -;; 5. Insert formatted rectangles in original buffer - (switch-to-buffer original-buffer) - (open-line table-entry-height) - (while (< column-number total-number-of-columns) - (setq here (point)) - (insert-rectangle - (eval (intern - (concat texinfo-multitable-rectangle-name - (int-to-string column-number))))) - (goto-char here) - (end-of-line) - (setq column-number (1+ column-number)))) - (kill-buffer texinfo-multitable-buffer-name) - (setq fill-column existing-fill-column))) - - -(when-broken texinfo-format-printindex - (fmakunbound 'texinfo-format-printindex)) - -(defun-maybe texinfo-format-printindex () - (let ((indexelts (symbol-value - (cdr (assoc (texinfo-parse-arg-discard) - texinfo-indexvar-alist)))) - opoint) - (insert "\n* Menu:\n\n") - (setq opoint (point)) - (texinfo-print-index nil indexelts) - - (if (memq system-type '(vax-vms windows-nt ms-dos)) - (texinfo-sort-region opoint (point)) - (shell-command-on-region opoint (point) "sort -fd" 1)))) - -;;; ptexinfmt.el ends here diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index 1904d48..d744b3d 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -1,5 +1,5 @@ ;;; rfc2047.el --- Functions for encoding and decoding rfc2047 messages -;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -88,7 +88,7 @@ Valid encodings are nil, `Q' and `B'.") "Alist of RFC2047 encodings to encoding functions.") (defvar rfc2047-q-encoding-alist - '(("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\\):" + '(("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\\):" . "-A-Za-z0-9!*+/" ) ;; = (\075), _ (\137), ? (\077) are used in the encoded word. ;; Avoid using 8bit characters. Some versions of Emacs has bug! @@ -156,14 +156,14 @@ Should be called narrowed to the head of the message." (mm-encode-coding-region (point-min) (point-max) mail-parse-charset))) ((null method) - (and (delq 'ascii - (mm-find-charset-region (point-min) + (and (delq 'ascii + (mm-find-charset-region (point-min) (point-max))) (if (or (message-options-get - 'rfc2047-encode-message-header-encode-any) + 'rfc2047-encode-message-header-encode-any) (message-options-set 'rfc2047-encode-message-header-encode-any - (y-or-n-p + (y-or-n-p "Some texts are not encoded. Encode anyway?"))) (rfc2047-encode-region (point-min) (point-max)) (error "Cannot send unencoded text.")))) @@ -196,7 +196,7 @@ The buffer may be narrowed." ;; Anything except most CTLs, WSP (setq word-chars "\010\012\014\041-\177")) (let (mail-parse-mule-charset - words point current + words point current result word) (save-restriction (narrow-to-region b e) @@ -531,7 +531,7 @@ If your Emacs implementation can't decode CHARSET, return nil." (mm-decode-coding-string (cond ((equal "B" encoding) - (base64-decode-string + (base64-decode-string (rfc2047-pad-base64 string))) ((equal "Q" encoding) (quoted-printable-decode-string diff --git a/lisp/smime.el b/lisp/smime.el index 2143a91..58be1ae 100644 --- a/lisp/smime.el +++ b/lisp/smime.el @@ -1,5 +1,5 @@ ;;; smime.el --- S/MIME support library -;; Copyright (c) 2000 Free Software Foundation, Inc. +;; Copyright (c) 2000, 2001 Free Software Foundation, Inc. ;; Author: Simon Josefsson ;; Keywords: SMIME X.509 PEM OpenSSL @@ -150,8 +150,8 @@ and the files themself should be in PEM format." :type 'directory :group 'smime) -(defcustom smime-openssl-program - (and (condition-case () +(defcustom smime-openssl-program + (and (condition-case () (eq 0 (call-process "openssl" nil nil nil "version")) (error nil)) "openssl") @@ -227,7 +227,7 @@ KEYFILE should contain a PEM encoded key and certificate." (interactive) (with-current-buffer (or buffer (current-buffer)) (smime-sign-region - (point-min) (point-max) + (point-min) (point-max) (or keyfile (smime-get-key-by-email (completing-read "Sign using which signature? " smime-keys nil nil @@ -241,7 +241,7 @@ a PEM encoded key and certificate. Uses current buffer if BUFFER is nil." (interactive) (with-current-buffer (or buffer (current-buffer)) - (smime-encrypt-region + (smime-encrypt-region (point-min) (point-max) (or certfiles (list (read-file-name "Recipient's S/MIME certificate: " @@ -259,7 +259,7 @@ nil." (error "No CA configured."))))) (with-current-buffer buffer (erase-buffer)) - (if (apply 'smime-call-openssl-region b e buffer "smime" "-verify" + (if (apply 'smime-call-openssl-region b e buffer "smime" "-verify" "-out" "/dev/null" CAs) (message "S/MIME message verified succesfully.") (message "S/MIME message NOT verified successfully.") @@ -269,7 +269,7 @@ nil." (let ((buffer (get-buffer-create smime-details-buffer))) (with-current-buffer buffer (erase-buffer)) - (if (apply 'smime-call-openssl-region b e buffer "smime" "-verify" + (if (apply 'smime-call-openssl-region b e buffer "smime" "-verify" "-noverify" "-out" '("/dev/null")) (message "S/MIME message verified succesfully.") (message "S/MIME message NOT verified successfully.") @@ -278,15 +278,15 @@ nil." (defun smime-decrypt-region (b e keyfile) (let ((buffer (generate-new-buffer (generate-new-buffer-name "*smime*"))) CAs) - (when (apply 'smime-call-openssl-region b e buffer "smime" "-decrypt" + (when (apply 'smime-call-openssl-region b e buffer "smime" "-decrypt" "-recip" (list keyfile)) - + ) (with-current-buffer (get-buffer-create smime-details-buffer) (goto-char (point-max)) (insert-buffer buffer)) (kill-buffer buffer))) - + ;; Verify+Decrypt buffer (defun smime-verify-buffer (&optional buffer) @@ -309,13 +309,13 @@ Does NOT verify validity of certificate." Uses current buffer if BUFFER is nil, queries user of KEYFILE is nil." (interactive) (with-current-buffer (or buffer (current-buffer)) - (smime-decrypt-region + (smime-decrypt-region (point-min) (point-max) (expand-file-name (or keyfile (smime-get-key-by-email (completing-read "Decrypt with which key? " smime-keys nil nil - (and (listp (car-safe smime-keys)) + (and (listp (car-safe smime-keys)) (caar smime-keys))))))))) ;; Various operations @@ -349,7 +349,7 @@ A string or a list of strings is returned." (when (smime-call-openssl-region b e buffer "x509" "-email" "-noout") (delete-region b e) (insert-buffer-substring buffer) - t))) + t))) (defalias 'smime-point-at-eol (if (fboundp 'point-at-eol) @@ -447,7 +447,7 @@ The following commands are available: (erase-buffer) (insert "\nYour keys:\n") (dolist (key smime-keys) - (insert + (insert (format "\t\t%s: %s\n" (car key) (cadr key)))) (insert "\nTrusted Certificate Authoritys:\n") (insert "\nKnown Certificates:\n")))) diff --git a/lisp/time-date.el b/lisp/time-date.el index 4c0fa38..38f9b1a 100644 --- a/lisp/time-date.el +++ b/lisp/time-date.el @@ -1,5 +1,5 @@ ;;; time-date.el --- Date and time handling functions -;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu Umeda diff --git a/lisp/webmail.el b/lisp/webmail.el index d947ca0..32d89fc 100644 --- a/lisp/webmail.el +++ b/lisp/webmail.el @@ -1,5 +1,5 @@ -;;; webmail.el --- interfacing with web mail -;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. +;;; webmail.el --- interface of web mail +;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu ;; Keywords: hotmail netaddress my-deja netscape @@ -32,7 +32,7 @@ ;; Todo: To support more web mail servers. -;; Known bugs: +;; Known bugs: ;; 1. Net@ddress may corrupt `X-Face'. ;; Warning: @@ -81,8 +81,8 @@ ;;(list-url "%s" webmail-aux) (list-snarf . webmail-hotmail-list) (article-snarf . webmail-hotmail-article) - (trash-url - "%s&login=%s&f=33792&curmbox=ACTIVE&_lang=&foo=inbox&js=&page=&%s=on&_HMaction=MoveTo&tobox=trAsH&nullbox=" + (trash-url + "%s&login=%s&f=33792&curmbox=ACTIVE&_lang=&foo=inbox&js=&page=&%s=on&_HMaction=MoveTo&tobox=trAsH&nullbox=" webmail-aux user id)) (yahoo (paranoid agent cookie post) @@ -90,7 +90,7 @@ (open-url "http://mail.yahoo.com/") (open-snarf . webmail-yahoo-open) (login-url;; yahoo will not accept GET - content + content ("%s" webmail-aux) ".tries=&.src=ym&.last=&promo=&.intl=&.bypass=&.partner=&.chkP=Y&.done=&login=%s&passwd=%s" user password) @@ -98,7 +98,7 @@ (list-url "%s&rb=Inbox&YN=1" webmail-aux) (list-snarf . webmail-yahoo-list) (article-snarf . webmail-yahoo-article) - (trash-url + (trash-url "%s/ym/ShowFolder?YY=52107&inc=50&order=down&sort=date&pos=0&box=Inbox&DEL=Delete&destBox=&Mid=%s&destBox2=" webmail-aux id)) (netaddress @@ -107,18 +107,18 @@ (open-url "http://www.netaddress.com/") (open-snarf . webmail-netaddress-open) (login-url - content + content ("%s" webmail-aux) - "LoginState=2&SuccessfulLogin=%%2Ftpl&NewServerName=www.netaddress.com&JavaScript=JavaScript1.2&DomainID=4&NA31site=classic.netaddress.com&NA31port=80&UserID=%s&passwd=%s" + "LoginState=2&SuccessfulLogin=%%2Ftpl&NewServerName=www.netaddress.com&JavaScript=JavaScript1.2&DomainID=4&Domain=usa.net&NA31site=classic.netaddress.com&NA31port=80&UserID=%s&passwd=%s" user password) (login-snarf . webmail-netaddress-login) - (list-url + (list-url "http://www.netaddress.com/tpl/Mail/%s/List?FolderID=-4&SortUseCase=True" webmail-session) (list-snarf . webmail-netaddress-list) (article-url "http://www.netaddress.com/") (article-snarf . webmail-netaddress-article) - (trash-url + (trash-url "http://www.netaddress.com/tpl/Message/%s/Move?FolderID=-4&Q=%s&N=&Sort=Date&F=-1" webmail-session id)) (netscape @@ -127,18 +127,18 @@ (open-url "http://ureg.netscape.com/iiop/UReg2/login/login?U2_LA=en&U2_BACK_FROM_CJ=true&U2_CS=iso-8859-1&U2_ENDURL=http://webmail.netscape.com/tpl/Subscribe/Step1&U2_NEW_ENDURL=http://webmail.netscape.com/tpl/Subscribe/Step1&U2_EXITURL=http://home.netscape.com/&U2_SOURCE=Webmail") (open-snarf . webmail-netscape-open) (login-url - content + content ("http://ureg.netscape.com/iiop/UReg2/login/loginform") "U2_USERNAME=%s&U2_PASSWORD=%s%s" user password webmail-aux) (login-snarf . webmail-netaddress-login) - (list-url + (list-url "http://webmail.netscape.com/tpl/Mail/%s/List?FolderID=-4&SortUseCase=True" webmail-session) (list-snarf . webmail-netaddress-list) (article-url "http://webmail.netscape.com/") (article-snarf . webmail-netscape-article) - (trash-url + (trash-url "http://webmail.netscape.com/tpl/Message/%s/Move?FolderID=-4&Q=%s&N=&Sort=Date&F=-1" webmail-session id)) (my-deja @@ -147,7 +147,7 @@ (open-url "http://www.deja.com/my/pr.xp") (open-snarf . webmail-my-deja-open) (login-url - content + content ("%s" webmail-aux) "member_name=%s&pw=%s&go=&priv_opt_MyDeja99=" user password) @@ -157,7 +157,7 @@ (trash-url webmail-aux id)))) (defvar webmail-variables - '(address article-snarf article-url list-snarf list-url + '(address article-snarf article-url list-snarf list-url login-url login-snarf open-url open-snarf site articles post-process paranoid trash-url)) @@ -201,7 +201,7 @@ (defun webmail-debug (str) (with-temp-buffer (insert "\n---------------- A bug at " str " ------------------\n") - (mapcar #'(lambda (sym) + (mapcar #'(lambda (sym) (if (boundp sym) (pp `(setq ,sym ',(eval sym)) (current-buffer)))) '(webmail-type user)) @@ -264,7 +264,7 @@ (defun webmail-url (xurl) (mm-with-unibyte-current-buffer - (cond + (cond ((eq (car xurl) 'content) (pop xurl) (webmail-fetch-simple (if (stringp (car xurl)) @@ -300,7 +300,7 @@ ;; instead of 303, though they mean 303. (defun webmail-url-confirmation-func (prompt) - (cond + (cond ((equal prompt (concat "Honor redirection with non-GET method " "(possible security risks)? ")) nil) @@ -311,7 +311,7 @@ (defun webmail-refresh-redirect () "Redirect refresh url in META." (goto-char (point-min)) - (while (re-search-forward + (while (re-search-forward "]*URL=\\([^\"]+\\)\"" nil t) (let ((url (match-string 1))) @@ -341,19 +341,19 @@ item id (n 0)) (webmail-init) (setq webmail-articles nil) - (when webmail-open-url + (when webmail-open-url (erase-buffer) (webmail-url webmail-open-url)) (if webmail-open-snarf (funcall webmail-open-snarf)) - (when webmail-login-url + (when webmail-login-url (erase-buffer) (webmail-url webmail-login-url)) - (if webmail-login-snarf + (if webmail-login-snarf (funcall webmail-login-snarf)) - (when webmail-list-url + (when webmail-list-url (erase-buffer) (webmail-url webmail-list-url)) - (if webmail-list-snarf + (if webmail-list-snarf (funcall webmail-list-snarf)) (while (setq item (pop webmail-articles)) (message "Fetching mail #%d..." (setq n (1+ n))) @@ -361,7 +361,7 @@ (mm-with-unibyte-current-buffer (nnweb-insert (cdr item))) (setq id (car item)) - (if webmail-article-snarf + (if webmail-article-snarf (funcall webmail-article-snarf file id)) (when (and webmail-trash-url webmail-move-to-trash-can) (message "Move mail #%d to trash can..." n) @@ -371,7 +371,7 @@ (let (buf) (while (setq buf (pop webmail-buffer-list)) (kill-buffer buf)))) - (error + (error (let (buf) (while (setq buf (pop webmail-buffer-list)) (kill-buffer buf))) @@ -391,7 +391,7 @@ (defun webmail-hotmail-open () (goto-char (point-min)) - (if (re-search-forward + (if (re-search-forward "action=\"https?://\\([^/]+\\)/cgi-bin/dologin" nil t) (setq webmail-aux (match-string 1)) (webmail-error "open@1"))) @@ -399,12 +399,12 @@ (defun webmail-hotmail-login () (let (site) (goto-char (point-min)) - (if (re-search-forward + (if (re-search-forward "https?://\\([^/]+hotmail\\.msn\\.com\\)/cgi-bin/" nil t) (setq site (match-string 1)) (webmail-error "login@1")) (goto-char (point-min)) - (if (re-search-forward + (if (re-search-forward "\\(/cgi-bin/HoTMaiL\\?[^\"]*a=b[^\"]*\\)" nil t) (setq webmail-aux (concat "http://" site (match-string 1))) (webmail-error "login@2")))) @@ -415,27 +415,27 @@ (let (site url newp (total "0")) (if (eobp) (setq total "0") - (if (re-search-forward "\\([0-9]+\\) *(\\([0-9]+\\) new)" nil t) - (message "Found %s (%s new)" (setq total (match-string 1)) + (if (re-search-forward "\\([0-9]+\\) *(\\([0-9]+\\) new)" nil t) + (message "Found %s (%s new)" (setq total (match-string 1)) (match-string 2)) - (if (re-search-forward "\\([0-9]+\\) new" nil t) + (if (re-search-forward "\\([0-9]+\\) new" nil t) (message "Found %s new" (setq total (match-string 1))) (webmail-error "list@0")))) (unless (equal total "0") (goto-char (point-min)) - (if (re-search-forward + (if (re-search-forward "https?://\\([^/]+hotmail\\.msn\\.com\\)/cgi-bin/" nil t) (setq site (match-string 1)) (webmail-error "list@1")) (goto-char (point-min)) (if (re-search-forward "disk=\\([^&]*\\)&" nil t) - (setq webmail-aux - (concat "http://" site "/cgi-bin/HoTMaiL?disk=" + (setq webmail-aux + (concat "http://" site "/cgi-bin/HoTMaiL?disk=" (match-string 1))) (webmail-error "list@2")) (goto-char (point-max)) - (while (re-search-backward - "newmail\\.gif\\|href=\"\\(/cgi-bin/getmsg\\?[^\"]+\\)\"" + (while (re-search-backward + "newmail\\.gif\\|href=\"\\(/cgi-bin/getmsg\\?[^\"]+\\)\"" nil t) (if (setq url (match-string 1)) (progn @@ -443,7 +443,7 @@ (let (id) (if (string-match "msg=\\([^&]+\\)" url) (setq id (match-string 1 url))) - (push (cons id (concat "http://" site url "&raw=0")) + (push (cons id (concat "http://" site url "&raw=0")) webmail-articles))) (setq newp nil)) (setq newp t)))))) @@ -453,7 +453,7 @@ (defun webmail-hotmail-article (file id) (goto-char (point-min)) (skip-chars-forward " \t\n\r") - (unless (eobp) + (unless (eobp) (if (not (search-forward "
" nil t))
 	(webmail-error "article@3"))
     (skip-chars-forward "\n\r\t ")
@@ -489,7 +489,7 @@
       (narrow-to-region (point-min) (point))
       (if (not (search-backward "" nil t)
@@ -507,8 +507,8 @@
       (widen)
       (insert "\n")
       (setq p (point))
-      (while (re-search-forward 
-	      "\\|
\\|\\(http://[^/]+/cgi-bin/getmsg/\\([^\?]+\\)\?[^\"]*\\)\"" 
+      (while (re-search-forward
+	      "\\|
\\|\\(http://[^/]+/cgi-bin/getmsg/\\([^\?]+\\)\?[^\"]*\\)\""
 	      nil t)
 	(if (setq attachment (match-string 1))
 	    (let ((filename (match-string 2))
@@ -520,7 +520,7 @@
 		(push (current-buffer) webmail-buffer-list)
 		(setq bufname (buffer-name)))
 	      (setq mime t)
-	      (insert "<#part type=" 
+	      (insert "<#part type="
 		      (or (and filename
 			       (string-match "\\.[^\\.]+$" filename)
 			       (mailcap-extension-to-mime
@@ -537,7 +537,7 @@
 		  (webmail-error "article@1.2")
 		(delete-region (match-beginning 0) (match-end 0)))
 	    (setq count 1)
-	    (while (and (> count 0) 
+	    (while (and (> count 0)
 			(re-search-forward "
\\|\\(
\\)" nil t))
 	      (if (match-string 1)
 		  (setq count (1+ count))
@@ -546,7 +546,7 @@
 				   (match-end 0))))))
 	  (narrow-to-region p (point))
 	  (goto-char (point-min))
-	  (cond 
+	  (cond
 	   ((looking-at "
")
 	    (goto-char (match-end 0))
 	    (if (looking-at "$") (forward-char))
@@ -571,7 +571,7 @@
 	      "@" (symbol-name webmail-type) "\n")
       (if id
 	  (insert (format "X-Message-ID: <%s@hotmail.com>\n" id)))
-      (unless (looking-at "$") 
+      (unless (looking-at "$")
 	(if (search-forward "\n\n" nil t)
 	    (forward-line -1)
 	  (webmail-error "article@2")))
@@ -610,21 +610,21 @@
 (defun webmail-yahoo-list ()
   (let (url (newp t) (tofetch 0))
     (goto-char (point-min))
-    (when (re-search-forward 
-	   "showing [0-9]+-\\([0-9]+\\) of \\([0-9]+\\)" nil t) 
+    (when (re-search-forward
+	   "showing [0-9]+-\\([0-9]+\\) of \\([0-9]+\\)" nil t)
       ;;(setq listed (match-string 1))
       (message "Found %s mail(s)" (match-string 2)))
     (if (string-match "http://[^/]+" webmail-aux)
 	(setq webmail-aux (match-string 0 webmail-aux))
       (webmail-error "list@1"))
     (goto-char (point-min))
-    (while (re-search-forward 
+    (while (re-search-forward
 	    "bgcolor=\"#eeeeee\"\\|href=\"\\(/ym/ShowLetter\\?MsgId=\\([^&]+\\)&[^\"]*\\)\""
 	    nil t)
       (if (setq url (match-string 1))
 	  (progn
 	    (when (or newp (not webmail-newmail-only))
-	      (push (cons (match-string 2) (concat webmail-aux url "&toc=1")) 
+	      (push (cons (match-string 2) (concat webmail-aux url "&toc=1"))
 		    webmail-articles)
 	      (setq tofetch (1+ tofetch)))
 	    (setq newp t))
@@ -640,7 +640,7 @@
 	  (webmail-error "article@1"))
       (if (not (search-forward "" nil t))
 	  (webmail-error "article@3"))
       (narrow-to-region (point-min) (match-end 0))
@@ -702,7 +702,7 @@
 	      "@" (symbol-name webmail-type) "\n")
       (if id
 	  (insert (format "X-Message-ID: <%s@yahoo.com>\n" id)))
-      (unless (looking-at "$") 
+      (unless (looking-at "$")
 	(if (search-forward "\n\n" nil t)
 	    (forward-line -1)
 	  (webmail-error "article@2")))
@@ -724,8 +724,8 @@
 (defun webmail-netscape-open ()
   (goto-char (point-min))
   (setq webmail-aux "")
-  (while (re-search-forward 
-	  "TYPE=hidden *NAME=\\([^ ]+\\) *VALUE=\"\\([^\"]+\\)" 
+  (while (re-search-forward
+	  "TYPE=hidden *NAME=\\([^ ]+\\) *VALUE=\"\\([^\"]+\\)"
 	  nil t)
     (setq webmail-aux (concat webmail-aux "&" (match-string 1) "="
 			      (match-string 2)))))
@@ -747,16 +747,16 @@
   (webmail-refresh-redirect)
   (let (item id)
     (goto-char (point-min))
-    (when (re-search-forward 
-	   "(\\([0-9]+\\) unread, \\([0-9]+\\) total)" nil t) 
-      (message "Found %s mail(s), %s unread" 
+    (when (re-search-forward
+	   "(\\([0-9]+\\) unread, \\([0-9]+\\) total)" nil t)
+      (message "Found %s mail(s), %s unread"
 	       (match-string 2) (match-string 1)))
     (goto-char (point-min))
-    (while (re-search-forward 
+    (while (re-search-forward
 	    "MR\\[i\\]\\.R='\\([^']*\\)'\\|MR\\[i\\]\\.Q='\\([^']+\\)'" nil t)
       (if (setq id (match-string 2))
-	  (setq item 
-		(cons id 
+	  (setq item
+		(cons id
 		      (format "%s/tpl/Message/%s/Read?Q=%s&FolderID=-4&SortUseCase=True&Sort=Date&Headers=True"
 			      (car webmail-article-url)
 			      webmail-session id)))
@@ -767,7 +767,7 @@
 
 (defun webmail-netaddress-single-part ()
   (goto-char (point-min))
-  (cond 
+  (cond
    ((looking-at "[\t\040\r\n]*]+>[\t\040\r\n]*")
     ;; text/plain
     (replace-match "")
@@ -796,7 +796,7 @@
 	  (webmail-error "article@1"))
       (if (not (search-forward "
" nil t))
 	  (webmail-error "article@2"))
-      (delete-region (point-min) (match-beginning 0)) 
+      (delete-region (point-min) (match-beginning 0))
       (if (not (search-forward "
" nil t))
 	  (webmail-error "article@3"))
       (narrow-to-region (point-min) (match-end 0))
@@ -826,7 +826,7 @@
       (forward-line 14)
       (delete-region p (point))
       (goto-char (point-max))
-      (unless (re-search-backward 
+      (unless (re-search-backward
 	       "[\040\t]*
[\040\t\r\n]*
[\040\t\r\n]*<#/part>\n")
 		(setq p (point))))
 	  (delete-region p p1)
-	  (narrow-to-region 
+	  (narrow-to-region
 	   p
-	   (if (search-forward 
+	   (if (search-forward
 		""
 		nil t)
 	       (match-beginning 0)
@@ -881,7 +881,7 @@
 	      "@" (symbol-name webmail-type) "\n")
       (if id
 	  (insert (format "X-Message-ID: <%s@%s>\n" id webmail-address)))
-      (unless (looking-at "$") 
+      (unless (looking-at "$")
 	(if (search-forward "\n\n" nil t)
 	    (forward-line -1)
 	  (webmail-error "article@2")))
@@ -890,7 +890,7 @@
 	(goto-char (point-min))
 	(while (not (eobp))
 	  (if (looking-at "MIME-Version\\|Content-Type")
-	      (delete-region (point) 
+	      (delete-region (point)
 			     (progn
 			       (forward-line 1)
 			       (if (re-search-forward "^[^ \t]" nil t)
@@ -921,7 +921,7 @@
 	  (webmail-error "article@1"))
       (if (not (search-forward "" nil t))
 	  (webmail-error "article@2"))
-      (delete-region (point-min) (match-beginning 0)) 
+      (delete-region (point-min) (match-beginning 0))
       (if (not (search-forward "" nil t))
 	  (webmail-error "article@3"))
       (narrow-to-region (point-min) (match-end 0))
@@ -954,7 +954,7 @@
       (forward-line 14)
       (delete-region p (point))
       (goto-char (point-max))
-      (unless (re-search-backward 
+      (unless (re-search-backward
 	       "<#/part>\n")
 		(setq p (point))))
 	  (delete-region p p1)
-	  (narrow-to-region 
+	  (narrow-to-region
 	   p
-	   (if (search-forward 
+	   (if (search-forward
 		"
"
 		nil t)
 	       (match-beginning 0)
@@ -1009,7 +1009,7 @@
 	      "@" (symbol-name webmail-type) "\n")
       (if id
 	  (insert (format "X-Message-ID: <%s@%s>\n" id webmail-address)))
-      (unless (looking-at "$") 
+      (unless (looking-at "$")
 	(if (search-forward "\n\n" nil t)
 	    (forward-line -1)
 	  (webmail-error "article@2")))
@@ -1018,7 +1018,7 @@
 	(goto-char (point-min))
 	(while (not (eobp))
 	  (if (looking-at "MIME-Version\\|Content-Type")
-	      (delete-region (point) 
+	      (delete-region (point)
 			     (progn
 			       (forward-line 1)
 			       (if (re-search-forward "^[^ \t]" nil t)
@@ -1045,7 +1045,7 @@
 (defun webmail-my-deja-open ()
   (webmail-refresh-redirect)
   (goto-char (point-min))
-  (if (re-search-forward "action=\"\\([^\"]+login_confirm\\.xp[^\"]*\\)\"" 
+  (if (re-search-forward "action=\"\\([^\"]+login_confirm\\.xp[^\"]*\\)\""
 			 nil t)
       (setq webmail-aux (match-string 1))
     (webmail-error "open@1")))
@@ -1053,26 +1053,26 @@
 (defun webmail-my-deja-list ()
   (let (item id newp base)
     (goto-char (point-min))
-    (when (re-search-forward "href=\"\\(\\([^\"]*\\)/mailnf\\.[^\"]*\\)\"" 
+    (when (re-search-forward "href=\"\\(\\([^\"]*\\)/mailnf\\.[^\"]*\\)\""
 			     nil t)
       (let ((url (match-string 1)))
 	(setq base (match-string 2))
 	(erase-buffer)
 	(nnweb-insert url)))
     (goto-char (point-min))
-    (when (re-search-forward 
+    (when (re-search-forward
 	   "(\\([0-9]+\\) Message.?-[^>]*\\([0-9]+\\) New"
-	   nil t) 
-      (message "Found %s mail(s), %s unread" 
+	   nil t)
+      (message "Found %s mail(s), %s unread"
 	       (match-string 1) (match-string 2)))
     (goto-char (point-min))
-    (while (re-search-forward 
+    (while (re-search-forward
 	    "newmail\\.gif\\|href=\"[^\"]*\\(mailnf\\.[^\"]+act=view[^\"]+mid=\\([^\"&]+\\)[^\"]+\\)\""
 	    nil t)
       (if (setq id (match-string 2))
 	  (when (and (or newp (not webmail-newmail-only))
 		     (not (assoc id webmail-articles)))
-	    (push (cons id (setq webmail-aux 
+	    (push (cons id (setq webmail-aux
 				 (concat base "/" (match-string 1))))
 		  webmail-articles)
 	    (setq newp nil))
@@ -1081,7 +1081,7 @@
 
 (defun webmail-my-deja-article-part (base)
   (let (p)
-    (cond 
+    (cond
      ((looking-at "[\t\040\r\n]*