+2001-01-22 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * 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 <yamaoka@jpl.org>
* lisp/gnus-vers.el (gnus-revision-number): Increment to 04.
+2001-01-21 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * webmail.el (webmail-type-definition): netaddress changes.
+
+2001-01-21 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.el: Fix copyright. Remove trailing spaces.
+
+ * message.el (message-forward): Use mule4.
+
+2001-01-20 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-util.el (mm-string-as-unibyte): New.
+
+ * message.el (message-forward): Use it.
+
+2001-01-19 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * 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 <sj@extundo.com>
+
+ * 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 <sj@extundo.com>
+
+ * mailcap.el (mailcap-mime-data): Run `gnumeric' on
+ application/vnd.ms-excel attachments.
+
+2001-01-19 Simon Josefsson <sj@extundo.com>
+
+ * gnus-art.el (gnus-button-alist): Add `?=' to mailto URL regexp.
+
+2001-01-19 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-ignored-mail-headers): Ditto.
+
+2001-01-19 Simon Josefsson <sj@extundo.com>
+
+ * message.el (message-ignored-news-headers): Only search beginning
+ of line.
+
+2001-01-19 Alberto Lusiani <a.lusiani@noemail.org>
+
+ * message.el (message-send-mail): Content-Type may not be there.
+
2001-01-18 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
* gnus-ems.el (gnus-article-display-xface): Add BUFFER.
* 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\81\e,Av\e(Bm <jonkv@ida.liu.se>.
+ Kvarnstr\e,Av\e(Bm <jonkv@ida.liu.se>.
2000-12-30 00:17:38 Lars Magne Ingebrigtsen <larsi@gnus.org>
* message.el (message-forward): Save-restriction.
-2000-12-21 Kai Gro\81\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+2000-12-21 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
* gnus-art.el (article-treat-dumbquotes): More doc, provided by
Paul Stevenson <p.stevenson@surrey.ac.uk>
* message.el (message-font-lock-keywords): use
message-cite-prefix-regexp.
-2000-11-15 Kai Gro\81\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+2000-11-15 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
* gnus-group.el (gnus-group-jump-to-group-prompt): New variable by
- Stein Arild Str\81\e,Ax\e(Bmme.
+ Stein Arild Str\e,Ax\e(Bmme.
(gnus-group-jump-to-group): Use it.
(gnus-group-jump-to-group-prompt): Customize.
* gnus-art.el (gnus-mime-display-alternative): Show button if no
preferred part.
-2000-11-07 Kai Gro\81\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+2000-11-07 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
* gnus-sum.el (gnus-move-split-methods): Say that
`gnus-split-methods' uses file names, whereas this uses group
;;; 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 <larsi@gnus.org>
(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.
(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
(byte-recompile-directory "." 0))
\f
-(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))))
-
-\f
(defconst dgnushack-info-file-regexp-en
(let ((names '("gnus" "message" "emacs-mime"))
regexp name)
;;; 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 <larsi@gnus.org>
;; Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
;;; 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 <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
((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
(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))
(setq x-faces
(concat
(or x-faces "")
- (buffer-substring
+ (buffer-substring
(match-beginning 0)
(1- (re-search-forward
"^\\($\\|[^ \t]\\)" nil t))))))))
("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2
t gnus-button-message-id 3)
("\\(<URL: *\\)mailto: *\\([^> \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...
("<URL: *\\([^<>]*\\)>" 0 t gnus-button-embedded-url 1)
;;; 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 <larsi@gnus.org>
;;; 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 <larsi@gnus.org>
;;; 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 <wmperry@aventail.com>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
;; 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))
"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)))
;;; 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 <umerin@flab.flab.fujitsu.junet>
(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))))
(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)
(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))
(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
;;; 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 <kult@uni-paderborn.de>
;;; 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 <larsi@gnus.org>
(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)
(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)
;;; 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 <larsi@gnus.org>
;;; 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 <larsi@gnus.org>
;; Katsumi Yamaoka <yamaoka@jpl.org>
;;; 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 <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
`(quote (repeat (list (regexp :tag "Group")
,parameter-type)))))
(variable-default (plist-get rest :variable-default)))
- (list
+ (list
'progn
`(defcustom ,variable ,variable-default
,variable-document
:type '(choice (const nil)
integer))
-(gnus-define-group-parameter
+(gnus-define-group-parameter
auto-expire
:type bool
:function gnus-group-auto-expirable-p
: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.
: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.
(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)
;;; 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 <larsi@gnus.org>
: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
(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)))
(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))
(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
;;; 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 <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
`(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)))
"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/.*"
(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)
(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)
"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)))
(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
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)))
(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
(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)
(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."
(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
(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))
(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))
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.
(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
(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)
((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))
;;; 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 <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
;;; 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 <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
(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)
(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)
"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))
"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)
(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))
(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
(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)))
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)))
;;; 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 <larsi@gnus.org>
;; This file is part of GNU Emacs.
(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))
(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))
(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)))
(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)
(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
;;; 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 <simon@josefsson.org>
;; Keywords: Gnus, MIME, S/MIME, MML
(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 ()
(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)
(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)))
(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))
(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"
;;; 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 <larsi@gnus.org>
;; This file is part of GNU Emacs.
(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.
(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))
(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)
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))
(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
(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
(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))
(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))
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)))
(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))))))
(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)
(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
(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"))
(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")))
;;; 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 <zsh@cs.rochester.edu>
;; Keywords: PGP MIME MML
(eval-when-compile (require 'cl))
(require 'mm-decode)
-(defvar mml2015-use (or
+(defvar mml2015-use (or
(progn
(ignore-errors
(require 'gpg))
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
(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
(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)
(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
(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
(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))
(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)
(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))
(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)
(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
(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)))
(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))
(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
(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: ")))
;;; 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 <larsi@gnus.org>
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
(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.
;;; 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 <larsi@gnus.org>
;; Keywords: news
"by <a[^>]+>\\([^<]+\\)</a>[ \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 "")
(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) "%"
"by <a[^>]+>\\([^<]+\\)</a>[ \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 "")
(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) "%"
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))
(nnslashdot-write-groups)
(nnslashdot-generate-active)
t))
-
+
(deffoo nnslashdot-request-newgroups (date &optional server)
(nnslashdot-possibly-change-server nil server)
(nnslashdot-generate-active)
(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)
;;; 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 <dmoore@ucsd.edu>
(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
;;; 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 <ratinox@peorth.gweep.net>
+++ /dev/null
-;;; 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 <yoshiki@xemacs.org>
-;; Copyright (C) 2000 TAKAHASHI Kaoru <kaoru@kaisei.org>
-
-;; Author: TAKAHASHI Kaoru <kaoru@kaisei.org>
-;; Yoshiki Hayashi <yoshiki@xemacs.org>
-;; Maintainer: TAKAHASHI Kaoru <kaoru@kaisei.org>
-;; 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 <yoshiki@xemacs.org>
-;; 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 "\e$BI}9-J8;z\e(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)
-
-
-\f
-;;; 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))))
-
-
-\f
-;;; 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))
-
-
-\f
-;;; 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} ==> <o hacek accent
-(put 'v 'texinfo-format 'texinfo-format-hacek-accent)
-(defun-maybe texinfo-format-hacek-accent ()
- (insert "<" (texinfo-parse-arg-discard))
- (goto-char texinfo-command-start))
-
-;; @dotless{i} ==> 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))
-
-
-\f
-;;; 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) "'"))))
-
-
-\f
-;;; 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
-
-
-\f
-;;; 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
-
-
-\f
-;;; @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)))
-
-\f
-(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
;;; 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 <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
"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!
(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."))))
;; 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)
(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
;;; smime.el --- S/MIME support library
-;; Copyright (c) 2000 Free Software Foundation, Inc.
+;; Copyright (c) 2000, 2001 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Keywords: SMIME X.509 PEM OpenSSL
: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")
(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
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: "
(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.")
(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.")
(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)
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
(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)
(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"))))
;;; 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 <larsi@gnus.org>
;; Masanobu Umeda <umerin@mse.kyutech.ac.jp>
-;;; 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 <zsh@cs.rochester.edu>
;; Keywords: hotmail netaddress my-deja netscape
;; Todo: To support more web mail servers.
-;; Known bugs:
+;; Known bugs:
;; 1. Net@ddress may corrupt `X-Face'.
;; Warning:
;;(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)
(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)
(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
(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
(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
(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)
(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))
(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))
(defun webmail-url (xurl)
(mm-with-unibyte-current-buffer
- (cond
+ (cond
((eq (car xurl) 'content)
(pop xurl)
(webmail-fetch-simple (if (stringp (car xurl))
;; 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)
(defun webmail-refresh-redirect ()
"Redirect refresh url in META."
(goto-char (point-min))
- (while (re-search-forward
+ (while (re-search-forward
"<meta[ \t\r\n]*http-equiv=\"Refresh\"[^>]*URL=\\([^\"]+\\)\""
nil t)
(let ((url (match-string 1)))
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)))
(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)
(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)))
(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")))
(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"))))
(let (site url newp (total "0"))
(if (eobp)
(setq total "0")
- (if (re-search-forward "\\([0-9]+\\) *<b>(\\([0-9]+\\) new)" nil t)
- (message "Found %s (%s new)" (setq total (match-string 1))
+ (if (re-search-forward "\\([0-9]+\\) *<b>(\\([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
(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))))))
(defun webmail-hotmail-article (file id)
(goto-char (point-min))
(skip-chars-forward " \t\n\r")
- (unless (eobp)
+ (unless (eobp)
(if (not (search-forward "<pre>" nil t))
(webmail-error "article@3"))
(skip-chars-forward "\n\r\t ")
(narrow-to-region (point-min) (point))
(if (not (search-backward "<table" nil t 2))
(webmail-error "article@1.1"))
- (delete-region (point-min) (match-beginning 0))
+ (delete-region (point-min) (match-beginning 0))
(while (search-forward "<a href=" nil t)
(setq p (match-beginning 0))
(search-forward "</a>" nil t)
(widen)
(insert "\n")
(setq p (point))
- (while (re-search-forward
- "<tt>\\|<div>\\|\\(http://[^/]+/cgi-bin/getmsg/\\([^\?]+\\)\?[^\"]*\\)\""
+ (while (re-search-forward
+ "<tt>\\|<div>\\|\\(http://[^/]+/cgi-bin/getmsg/\\([^\?]+\\)\?[^\"]*\\)\""
nil t)
(if (setq attachment (match-string 1))
(let ((filename (match-string 2))
(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
(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 "</div>\\|\\(<div>\\)" nil t))
(if (match-string 1)
(setq count (1+ count))
(match-end 0))))))
(narrow-to-region p (point))
(goto-char (point-min))
- (cond
+ (cond
((looking-at "<pre>")
(goto-char (match-end 0))
(if (looking-at "$") (forward-char))
"@" (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")))
(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))
(webmail-error "article@1"))
(if (not (search-forward "<table" nil t))
(webmail-error "article@2"))
- (delete-region (point-min) (match-beginning 0))
+ (delete-region (point-min) (match-beginning 0))
(if (not (search-forward "</table>" nil t))
(webmail-error "article@3"))
(narrow-to-region (point-min) (match-end 0))
"@" (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")))
(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)))))
(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)))
(defun webmail-netaddress-single-part ()
(goto-char (point-min))
- (cond
+ (cond
((looking-at "[\t\040\r\n]*<font face=[^>]+>[\t\040\r\n]*")
;; text/plain
(replace-match "")
(webmail-error "article@1"))
(if (not (search-forward "<form>" nil t))
(webmail-error "article@2"))
- (delete-region (point-min) (match-beginning 0))
+ (delete-region (point-min) (match-beginning 0))
(if (not (search-forward "</form>" nil t))
(webmail-error "article@3"))
(narrow-to-region (point-min) (match-end 0))
(forward-line 14)
(delete-region p (point))
(goto-char (point-max))
- (unless (re-search-backward
+ (unless (re-search-backward
"[\040\t]*<br>[\040\t\r\n]*<br>[\040\t\r\n]*<form" p t)
(webmail-error "article@5"))
(delete-region (point) (point-max))
(insert "><#/part>\n")
(setq p (point))))
(delete-region p p1)
- (narrow-to-region
+ (narrow-to-region
p
- (if (search-forward
+ (if (search-forward
"<TABLE border=\"0\" WIDTH=\"98%\" cellpadding=0 cellspacing=0>"
nil t)
(match-beginning 0)
"@" (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")))
(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)
(webmail-error "article@1"))
(if (not (search-forward "<form>" nil t))
(webmail-error "article@2"))
- (delete-region (point-min) (match-beginning 0))
+ (delete-region (point-min) (match-beginning 0))
(if (not (search-forward "</form>" nil t))
(webmail-error "article@3"))
(narrow-to-region (point-min) (match-end 0))
(forward-line 14)
(delete-region p (point))
(goto-char (point-max))
- (unless (re-search-backward
+ (unless (re-search-backward
"<form name=\"Transfer2\"" p t)
(webmail-error "article@5"))
(delete-region (point) (point-max))
(insert "><#/part>\n")
(setq p (point))))
(delete-region p p1)
- (narrow-to-region
+ (narrow-to-region
p
- (if (search-forward
+ (if (search-forward
"<TABLE border=\"0\" WIDTH=\"98%\" cellpadding=0 cellspacing=0>"
nil t)
(match-beginning 0)
"@" (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")))
(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)
(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")))
(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))
(defun webmail-my-deja-article-part (base)
(let (p)
- (cond
+ (cond
((looking-at "[\t\040\r\n]*<!--[^>]*>")
(replace-match ""))
((looking-at "[\t\040\r\n]*</PRE>")
(if (and (search-forward "File Type:" nil t)
(re-search-forward "<FONT[^>]+>\\([^<]+\\)" nil t))
(setq type (match-string 1)))
- (unless (re-search-forward "action=\"getattach\\.cgi/\\([^\"]+\\)"
+ (unless (re-search-forward "action=\"getattach\\.cgi/\\([^\"]+\\)"
nil t)
(webmail-error "article@5"))
(setq url (concat base "/getattach.cgi/" (match-string 1)
"?sm=Download"))
- (while (re-search-forward
- "type=hidden name=\"\\([^\"]+\\)\" value=\"\\([^\"]+\\)"
+ (while (re-search-forward
+ "type=hidden name=\"\\([^\"]+\\)\" value=\"\\([^\"]+\\)"
nil t)
(setq url (concat url "&" (match-string 1) "="
(match-string 2))))
(unless (string-match "\\([^\"]+\\)/mail" webmail-aux)
(webmail-error "article@0"))
(setq base (match-string 1 webmail-aux))
- (when (re-search-forward
+ (when (re-search-forward
"href=\"[^\"]*\\(mailnf\\.[^\"]+act=move[^\"]+mid=\\([^\"&]+\\)[^\"]+\\)\""
nil t)
(setq webmail-aux (concat base "/" (match-string 1)))
(webmail-error "article@4"))
(delete-region (point) (point-max))
(goto-char (point-min))
- (while (not (eobp))
+ (while (not (eobp))
(webmail-my-deja-article-part base))
(insert "MIME-Version: 1.0\n"
(prog1
+2001-01-21 Raymond Scholz <ray-2001@zonix.de>
+
+ * message.texi: Rename X-Mailer and X-Newsreader to User-Agent.
+
+2001-01-19 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * infohack.el: New file.
+
+ * Makefile.in: Use it.
+
2001-01-18 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
* gnus.texi (Hiding Headers): Add.
-prefix = @prefix@
infodir = @infodir@
+prefix = @prefix@
srcdir = @srcdir@
subdir = texi
top_srcdir = @top_srcdir@
MAKEINFO=@MAKEINFO@
EMACS=@EMACS@
EMACSINFO=$(EMACS) -batch -q -no-site-file
-INFOSWI=-l ./dgnushack.el -f dgnushack-texi-format
-XINFOSWI=-l ./dgnushack.el -f dgnushack-texi-add-suffix-and-format
-EMACSINFOHACK=-eval '(while (re-search-forward "@\\(end \\)?ifnottex" nil t) (replace-match ""))'
PDFLATEX=pdflatex
LATEX=latex
DVIPS=dvips
most: texi2latex.elc latex latexps
%-ja: %-ja.texi
- cd ../lisp && $(EMACSINFO) -eval '(find-file "$<")' \
- $(EMACSINFOHACK) $(INFOSWI) ../texi/$<; \
+ $(EMACSINFO) -l $(srcdir)/infohack.el \
+ -eval '(infohack-texi-format "$<")'
%-ja.info: %-ja.texi
- cd ../lisp && $(EMACSINFO) -eval '(find-file "$<")' \
- $(EMACSINFOHACK) $(XINFOSWI) ../texi/$<; \
+ $(EMACSINFO) -l $(srcdir)/infohack.el \
+ -eval '(infohack-texi-format "$<" t)'
%.info: %.texi
- if test $(MAKEINFO) = no; then \
- cd ../lisp && $(EMACSINFO) -eval '(find-file "$<")' \
- $(EMACSINFOHACK) $(XINFOSWI) ../texi/$<; \
+ if test "x$(MAKEINFO)" != "xno"; then \
+ $(MAKEINFO) -I $(srcdir) -o $@ $<; \
else \
- makeinfo -o $@ $<; \
+ $(EMACSINFO) -l $(srcdir)/infohack.el \
+ -eval '(infohack-texi-format "$<" t)'; \
fi
.SUFFIXES: .texi .dvi .ps .pdf
.texi:
if test "x$(MAKEINFO)" != "xno" ; then \
- makeinfo -I $(srcdir) -o $* $<; \
+ $(MAKEINFO) -I $(srcdir) -o $* $<; \
else \
- cd ../lisp && $(EMACSINFO) -eval '(find-file "$<")' \
- $(EMACSINFOHACK) $(INFOSWI) ../texi/$<; \
+ $(EMACSINFO) -l $(srcdir)/infohack.el \
+ -eval '(infohack-texi-format "$<")'; \
fi
dvi: gnus.dvi message.dvi refcard.dvi emacs-mime.dvi
--- /dev/null
+;;; infohack.el --- a hack to format info file.
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
+;; Keywords: info
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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:
+
+;;; Code:
+
+(require 'texinfmt)
+
+(defun infohack-remove-unsupported ()
+ (goto-char (point-min))
+ (while (re-search-forward "@\\(end \\)?ifnottex" nil t)
+ (replace-match "")))
+
+(defun infohack (file)
+ (let ((dest-directory default-directory))
+ (find-file file)
+ (infohack-remove-unsupported)
+ (texinfo-every-node-update)
+ (texinfo-format-buffer t) ;; Don't save any file.
+ (setq default-directory dest-directory)
+ (setq buffer-file-name
+ (expand-file-name (file-name-nondirectory buffer-file-name)
+ default-directory))
+ (if (> (buffer-size) 100000)
+ (Info-split))
+ (save-buffer)))
+
+\f
+(let ((default-directory (expand-file-name "../lisp/"))
+ (features (cons 'w3-forms (copy-sequence features))))
+ ;; Adjust `load-path' for APEL.
+ (load-file "dgnushack.el"))
+(load-file (expand-file-name "ptexinfmt.el" "./"))
+
+(defun infohack-texi-format (file &optional addsuffix)
+ (let ((auto-save-default nil)
+ (find-file-run-dired nil)
+ coding-system-for-write
+ output-coding-system
+ (error 0))
+ (condition-case err
+ (progn
+ (find-file file)
+ (buffer-disable-undo (current-buffer))
+ (if (boundp 'MULE)
+ (setq output-coding-system 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))))
+ (infohack-remove-unsupported)
+ (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)))
+
+;;; infohack.el ends here
@vindex message-required-mail-headers
\e$B$3$NJQ?t$N9=J8$rCN$j$?$1$l$P!"\e(B@xref{News Headers} \e$B$r;2>H$7$F2<$5$$!#$=$l\e(B
\e$B$N=i4|CM$O\e(B @code{(From Date Subject (optional . In-Reply-To) Message-ID
-Lines (optional . X-Mailer))} \e$B$G$9!#\e(B
+Lines (optional . User-Agent))} \e$B$G$9!#\e(B
@item message-ignored-mail-headers
@vindex message-ignored-mail-headers
\e$BL>\e(B) \e$B$G$J$$$J$i\e(B \e$B$P!"\e(BMessage \e$B$O\e(B @code{mail-host-address} \e$B$r\e(B FQDN \e$B$H$7$F;H\e(B
\e$B$$$^$9!#\e(B
-@item X-Newsreader
-@cindex X-Nesreader
+@item User-Agent
+@cindex User-Agent
\e$B$3$NA*Br<+M3$J%X%C%@!<$O%m!<%+%kJQ?t\e(B @code{message-newsreader} \e$B$K$7$?$,$C\e(B
\e$B$F:n$i$l$^$9!#\e(B
-@item X-Mailer
-\e$B$3$NA*Br<+M3$J%X%C%@!<$O!"4{$K\e(B @code{X-Nesreader} \e$B%X%C%@!<$,B8:_$7$F$$$k\e(B
-\e$B>l9g0J30$O!"%m!<%+%kJQ?t\e(B @code{message-mailer} \e$B$K$7$?$,$C$F:n$i$l$^$9!#\e(B
-
@item In-Reply-To
\e$B$3$NA*Br<+M3$J%X%C%@!<$OJVEz$7$F$$$k5-;v$N\e(B @code{Date} \e$B$H\e(B @code{From} \e$B%X%C\e(B
\e$B%@!<$r;H$C$F:n$i$l$^$9!#\e(B
@vindex message-required-mail-headers
@xref{News Headers}, for the syntax of this variable. It is
@code{(From Date Subject (optional . In-Reply-To) Message-ID Lines
-(optional . X-Mailer))} by default.
+(optional . User-Agent))} by default.
@item message-ignored-mail-headers
@vindex message-ignored-mail-headers
this isn't a fully qualified domain name (FQDN), Message will use
@code{mail-host-address} as the FQDN of the machine.
-@item X-Newsreader
-@cindex X-Newsreader
+@item User-Agent
+@cindex User-Agent
This optional header will be filled out according to the
@code{message-newsreader} local variable.
-@item X-Mailer
-This optional header will be filled out according to the
-@code{message-mailer} local variable, unless there already is an
-@code{X-Newsreader} header present.
-
@item In-Reply-To
This optional header is filled out using the @code{Date} and @code{From}
header of the article being replied to.
--- /dev/null
+;;; 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 <yoshiki@xemacs.org>
+;; Copyright (C) 2000 TAKAHASHI Kaoru <kaoru@kaisei.org>
+
+;; Author: TAKAHASHI Kaoru <kaoru@kaisei.org>
+;; Yoshiki Hayashi <yoshiki@xemacs.org>
+;; Maintainer: TAKAHASHI Kaoru <kaoru@kaisei.org>
+;; 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 <yoshiki@xemacs.org>
+;; 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 "\e$BI}9-J8;z\e(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)
+
+
+\f
+;;; 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))))
+
+
+\f
+;;; 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))
+
+
+\f
+;;; 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} ==> <o hacek accent
+(put 'v 'texinfo-format 'texinfo-format-hacek-accent)
+(defun-maybe texinfo-format-hacek-accent ()
+ (insert "<" (texinfo-parse-arg-discard))
+ (goto-char texinfo-command-start))
+
+;; @dotless{i} ==> 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))
+
+
+\f
+;;; 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) "'"))))
+
+
+\f
+;;; 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
+
+
+\f
+;;; 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
+
+
+\f
+;;; @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)))
+
+\f
+(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
projects / elisp / gnus.git- / commitdiff