@SET_MAKE@
EMACS = @EMACS@
-XEMACS = xemacs
+XEMACS = xemacs21
all: lick info
rm lisp/*.elc
x:
- make EMACS=xemacs
+ make EMACS=xemacs21
distclean:
make clean
rm -f config.log config.status Makefile
osome:
- make EMACS=emacs-19.34 some
+ make EMACS=xemacs21 some
config.status: $(srcdir)/configure
$(SHELL) ./config.status --recheck
+Sat Aug 29 22:20:39 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Gnus v0.4 is released.
+
+1998-08-29 20:53:29 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-article-decode-mime-words): New command and
+ keystroke.
+
+ * qp.el (quoted-printable-decode-region): Don't use hexl.
+
+ * gnus-xmas.el (gnus-xmas-logo-color-style): Changed to dino.
+
+ * gnus-sum.el (gnus-parse-headers-hook): Default to nil.
+ (gnus-structured-field-decoder): Removed.
+ (gnus-unstructured-field-decoder): Ditto.
+
+ * mm-decode.el: New file.
+
+ * qp.el: New file.
+
+ * gnus-art.el (article-mime-decode-quoted-printable): Removed.
+
+ * gnus-ems.el (fboundp): Removed gnus-split-string.
+
+ * gnus.el (gnus-splash-face): Doc fix.
+
+ * gnus-ems.el (fboundp): Don't bind mail-file-babyl-p.
+
+ * gnus-art.el (article-mime-decode-quoted-printable): Don't use
+ hexl.
+
+ * nnheader.el (nnheader-temp-write): Removed.
+
Sat Aug 29 20:34:17 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Gnus v0.3 is released.
(defun gnus-agent-read-file (file)
"Load FILE and do a `read' there."
- (nnheader-temp-write nil
+ (with-temp-buffer
(ignore-errors
(nnheader-insert-file-contents file)
(goto-char (point-min))
(defun gnus-agent-write-servers ()
"Write the alist of covered servers."
- (nnheader-temp-write (nnheader-concat gnus-agent-directory "lib/servers")
+ (with-temp-file (nnheader-concat gnus-agent-directory "lib/servers")
(prin1 gnus-agent-covered-methods (current-buffer))))
;;;
(gnus-agent-lib-file "active")
(gnus-agent-lib-file "groups"))))
(gnus-make-directory (file-name-directory file))
- (nnheader-temp-write file
+ (with-temp-file file
(when (file-exists-p file)
(nnheader-insert-file-contents file))
(goto-char (point-min))
;; Fetch the articles from the backend.
(if (gnus-check-backend-function 'retrieve-articles group)
(setq pos (gnus-retrieve-articles articles group))
- (nnheader-temp-write nil
+ (with-temp-file nil
(let (article)
(while (setq article (pop articles))
(when (gnus-request-article article group)
nil 'silent)
(pop gnus-agent-buffer-alist))
(while gnus-agent-group-alist
- (nnheader-temp-write (caar gnus-agent-group-alist)
+ (with-temp-file (caar gnus-agent-group-alist)
(princ (cdar gnus-agent-group-alist))
(insert "\n"))
(pop gnus-agent-group-alist))))
(defun gnus-agent-save-alist (group &optional articles state dir)
"Save the article-state alist for GROUP."
- (nnheader-temp-write (if dir
- (concat dir ".agentview")
- (gnus-agent-article-name ".agentview" group))
+ (with-temp-file (if dir
+ (concat dir ".agentview")
+ (gnus-agent-article-name ".agentview" group))
(princ (setq gnus-agent-article-alist
(nconc gnus-agent-article-alist
(mapcar (lambda (article) (cons article state))
"Write the category alist."
(setq gnus-category-predicate-cache nil
gnus-category-group-cache nil)
- (nnheader-temp-write (nnheader-concat gnus-agent-directory "lib/categories")
+ (with-temp-file (nnheader-concat gnus-agent-directory "lib/categories")
(prin1 gnus-category-alist (current-buffer))))
(defun gnus-category-edit-predicate (category)
:group 'gnus-article-washing)
(eval-and-compile
- (autoload 'hexl-hex-string-to-integer "hexl")
(autoload 'timezone-make-date-arpa-standard "timezone")
(autoload 'mail-extract-address-components "mail-extr"))
(while (search-forward "=10" nil t)
(replace-match " " t t))))
+(defun gnus-article-decode-mime-words ()
+ "Decode all MIME-encoded words in the article."
+ (interactive)
+ (save-excursion
+ (let (buffer-read-only)
+ (mm-decode-words-region (point-min) (point-max)))))
+
(defalias 'gnus-decode-rfc1522 'article-decode-rfc1522)
(defalias 'gnus-article-decode-rfc1522 'article-decode-rfc1522)
(defun article-decode-rfc1522 ()
- "Hack to remove QP encoding from headers."
- (let ((case-fold-search t)
- (inhibit-point-motion-hooks t)
- (buffer-read-only nil)
- string)
+ "Remove QP encoding from headers."
+ (let ((inhibit-point-motion-hooks t)
+ (buffer-read-only nil))
(save-restriction
- (narrow-to-region
- (goto-char (point-min))
- (or (search-forward "\n\n" nil t) (point-max)))
- (goto-char (point-min))
- (while (re-search-forward
- "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t)
- (setq string (match-string 1))
- (save-restriction
- (narrow-to-region (match-beginning 0) (match-end 0))
- (delete-region (point-min) (point-max))
- (insert string)
- (article-mime-decode-quoted-printable
- (goto-char (point-min)) (point-max))
- (subst-char-in-region (point-min) (point-max) ?_ ? )
- (goto-char (point-max)))
- (goto-char (point-min))))))
+ (message-narrow-to-head)
+ (mm-decode-words-region (point-min) (point-max)))))
(defun article-de-quoted-unreadable (&optional force)
- "Do a naive translation of a quoted-printable-encoded article.
-This is in no way, shape or form meant as a replacement for real MIME
-processing, but is simply a stop-gap measure until MIME support is
-written.
+ "Translation a quoted-printable-encoded article.
If FORCE, decode the article whether it is marked as quoted-printable
or not."
(interactive (list 'force))
(save-excursion
- (let ((case-fold-search t)
- (buffer-read-only nil)
+ (let ((buffer-read-only nil)
(type (gnus-fetch-field "content-transfer-encoding")))
(gnus-article-decode-rfc1522)
(when (or force
(and type (string-match "quoted-printable" (downcase type))))
(goto-char (point-min))
(search-forward "\n\n" nil 'move)
- (article-mime-decode-quoted-printable (point) (point-max))))))
+ (quoted-printable-decode-region (point) (point-max))))))
(defun article-mime-decode-quoted-printable-buffer ()
"Decode Quoted-Printable in the current buffer."
- (article-mime-decode-quoted-printable (point-min) (point-max)))
-
-(defun article-mime-decode-quoted-printable (from to)
- "Decode Quoted-Printable in the region between FROM and TO."
- (interactive "r")
- (goto-char from)
- (while (search-forward "=" to t)
- (cond ((eq (following-char) ?\n)
- (delete-char -1)
- (delete-char 1))
- ((looking-at "[0-9A-F][0-9A-F]")
- (subst-char-in-region
- (1- (point)) (point) ?=
- (hexl-hex-string-to-integer
- (buffer-substring (point) (+ 2 (point)))))
- (delete-char 2))
- ((looking-at "=")
- (delete-char 1))
- ((gnus-message 3 "Malformed MIME quoted-printable message")))))
+ (quoted-printable-decode-region (point-min) (point-max)))
(defun article-hide-pgp (&optional arg)
"Toggle hiding of any PGP headers and signatures in the current article.
(setq b (point))
(point-max))
(setq e (point-max)))
- (nnheader-temp-write nil
+ (with-temp-buffer
(insert-buffer-substring gnus-article-buffer b e)
(require 'url)
(save-window-excursion
(defun gnus-output-to-file (file-name)
"Append the current article to a file named FILE-NAME."
(let ((artbuf (current-buffer)))
- (nnheader-temp-write nil
+ (with-temp-buffer
(insert-buffer-substring artbuf)
;; Append newline at end of the buffer as separator, and then
;; save it to file.
(defun gnus-url-parse-query-string (query &optional downcase)
(let (retval pairs cur key val)
- (setq pairs (gnus-split-string query "&"))
+ (setq pairs (split-string query "&"))
(while pairs
(setq cur (car pairs)
pairs (cdr pairs))
(when (or force
(and gnus-cache-active-hashtb
gnus-cache-active-altered))
- (nnheader-temp-write gnus-cache-active-file
+ (with-temp-file gnus-cache-active-file
(mapatoms
(lambda (sym)
(when (and sym (boundp sym))
"Save the duplicate suppression list."
(when (and gnus-save-duplicate-list
gnus-dup-list-dirty)
- (nnheader-temp-write gnus-duplicate-file
+ (with-temp-file gnus-duplicate-file
(gnus-prin1 `(setq gnus-dup-list ',gnus-dup-list))))
(setq gnus-dup-list-dirty nil))
(autoload 'gnus-xmas-redefine "gnus-xmas")
(autoload 'appt-select-lowest-window "appt"))
-(or (fboundp 'mail-file-babyl-p)
- (fset 'mail-file-babyl-p 'rmail-file-p))
-
;;; Mule functions.
(defun gnus-mule-cite-add-face (number prefix face)
(truncate-string valstr (, max-width))
valstr))))
-(defun gnus-encode-coding-string (string system)
- string)
-
-(defun gnus-decode-coding-string (string system)
- string)
-
(eval-and-compile
(if (string-match "XEmacs\\|Lucid" emacs-version)
nil
((string-match "XEmacs\\|Lucid" emacs-version)
(gnus-xmas-define))
- ((or (not (boundp 'emacs-minor-version))
- (and (< emacs-major-version 20)
- (< emacs-minor-version 30)))
- ;; Remove the `intangible' prop.
- (let ((props (and (boundp 'gnus-hidden-properties)
- gnus-hidden-properties)))
- (while (and props (not (eq (car (cdr props)) 'intangible)))
- (setq props (cdr props)))
- (when props
- (setcdr props (cdr (cdr (cdr props))))))
- (unless (fboundp 'buffer-substring-no-properties)
- (defun buffer-substring-no-properties (beg end)
- (format "%s" (buffer-substring beg end)))))
-
((boundp 'MULE)
(provide 'gnusutil))))
(fset 'gnus-cite-add-face 'gnus-mule-cite-add-face)
(fset 'gnus-max-width-function 'gnus-mule-max-width-function)
(fset 'gnus-summary-set-display-table (lambda ()))
- (fset 'gnus-encode-coding-string 'encode-coding-string)
- (fset 'gnus-decode-coding-string 'decode-coding-string)
(when (boundp 'gnus-check-before-posting)
(setq gnus-check-before-posting
(erase-buffer)
(when (and dir
(file-exists-p (setq file (concat dir "x-splash"))))
- (nnheader-temp-write nil
+ (with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(ignore-errors
(make-face 'gnus-splash))
(setq height (/ (car pixmap) (frame-char-height))
width (/ (cadr pixmap) (frame-char-width)))
- (set-face-foreground 'gnus-splash "ForestGreen")
+ (set-face-foreground 'gnus-splash "Brown")
(set-face-stipple 'gnus-splash pixmap)
(insert-char ?\n (* (/ (window-height) 2 height) height))
(setq i height)
(goto-char (point-min))
(sit-for 0))))))
-(if (fboundp 'split-string)
- (fset 'gnus-split-string 'split-string)
- (defun gnus-split-string (string pattern)
- "Return a list of substrings of STRING which are separated by PATTERN."
- (let (parts (start 0))
- (while (string-match pattern string start)
- (setq parts (cons (substring string start (match-beginning 0)) parts)
- start (match-end 0)))
- (nreverse (cons (substring string start) parts)))))
-
(provide 'gnus-ems)
;; Local Variables:
(push (cons header regexps) scores))
scores)))
(gnus-group-make-group group "nnkiboze" address)
- (nnheader-temp-write (gnus-score-file-name (concat "nnkiboze:" group))
+ (with-temp-file (gnus-score-file-name (concat "nnkiboze:" group))
(let (emacs-lisp-mode-hook)
(pp scores (current-buffer)))))
(save-excursion
(let ((dependencies (make-vector 10 nil))
headers header)
- (nnheader-temp-write nil
+ (with-temp-buffer
(setq headers
(if (eq 'nov
(gnus-retrieve-headers
"Save the NoCeM cache."
(when (and gnus-nocem-alist
gnus-nocem-touched-alist)
- (nnheader-temp-write (gnus-nocem-cache-file)
+ (with-temp-file (gnus-nocem-cache-file)
(gnus-prin1 `(setq gnus-nocem-alist ',gnus-nocem-alist)))
(setq gnus-nocem-touched-alist nil)))
(defun gnus-nocem-save-active ()
"Save the NoCeM active file."
- (nnheader-temp-write (gnus-nocem-active-file)
+ (with-temp-file (gnus-nocem-active-file)
(gnus-prin1 `(setq gnus-nocem-active ',gnus-nocem-active))))
(defun gnus-nocem-alist-to-hashtb ()
;; Perform adaptive word scoring.
(when (and (listp gnus-newsgroup-adaptive)
(memq 'word gnus-newsgroup-adaptive))
- (nnheader-temp-write nil
+ (with-temp-buffer
(let* ((hashtb (gnus-make-hashtable 1000))
(date (gnus-day-number (current-time-string)))
(data gnus-newsgroup-data)
(defun gnus-sort-score-files (files)
"Sort FILES so that the most general files come first."
- (nnheader-temp-write nil
+ (with-temp-buffer
(let ((alist
(mapcar
(lambda (file)
"Write the AREAS file."
(interactive)
(when gnus-soup-areas
- (nnheader-temp-write (concat gnus-soup-directory "AREAS")
+ (with-temp-file (concat gnus-soup-directory "AREAS")
(let ((areas gnus-soup-areas)
area)
(while (setq area (pop areas))
(defun gnus-soup-write-replies (dir areas)
"Write a REPLIES file in DIR containing AREAS."
- (nnheader-temp-write (concat dir "REPLIES")
+ (with-temp-file (concat dir "REPLIES")
(let (area)
(while (setq area (pop areas))
(insert (format "%s\t%s\t%s\n"
(fboundp 'gnus-mule-get-coding-system)
(gnus-mule-get-coding-system (symbol-name group)))))
(if coding
- (setq str (gnus-decode-coding-string str (car coding))))
+ (setq str (decode-coding-string str (car coding))))
(set group str)))
(forward-line 1))))
(gnus-message 5 "Reading descriptions file...done")
:group 'gnus-summary-visual
:type 'hook)
-(defcustom gnus-structured-field-decoder 'identity
- "Function to decode non-ASCII characters in structured field for summary."
- :group 'gnus-various
- :type 'function)
-
-(defcustom gnus-unstructured-field-decoder 'identity
- "Function to decode non-ASCII characters in unstructured field for summary."
- :group 'gnus-various
- :type 'function)
-
-(defcustom gnus-parse-headers-hook
- (list 'gnus-hack-decode-rfc1522 'gnus-decode-rfc1522)
+(defcustom gnus-parse-headers-hook nil
"*A hook called before parsing the headers."
:group 'gnus-various
:type 'hook)
"c" gnus-article-highlight-citation
"s" gnus-article-highlight-signature)
+ (gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map)
+ "w" gnus-article-decode-mime-words)
+
(gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map)
"z" gnus-article-date-ut
"u" gnus-article-date-ut
["Headers" gnus-article-highlight-headers t]
["Signature" gnus-article-highlight-signature t]
["Citation" gnus-article-highlight-citation t])
+ ("MIME"
+ ["Words" gnus-article-decode-mime-words t]
+ ["QP" gnus-article-de-quoted-unreadable t])
("Date"
["Local" gnus-article-date-local t]
["ISO8601" gnus-article-date-iso8601 t]
(setq header
(make-full-mail-header
number ; number
- (funcall
- gnus-unstructured-field-decoder (gnus-nov-field)) ; subject
- (funcall
- gnus-structured-field-decoder (gnus-nov-field)) ; from
+ (mm-decode-words-string (gnus-nov-field)) ; subject
+ (mm-decode-words-string (gnus-nov-field)) ; from
(gnus-nov-field) ; date
(or (gnus-nov-field)
(nnheader-generate-fake-message-id)) ; id
(progn
(goto-char p)
(if (search-forward "\nsubject: " nil t)
- (funcall
- gnus-unstructured-field-decoder (nnheader-header-value))
+ (mm-decode-words-string (nnheader-header-value))
"(none)"))
;; From.
(progn
(goto-char p)
(if (search-forward "\nfrom: " nil t)
- (funcall
- gnus-structured-field-decoder (nnheader-header-value))
+ (mm-decode-words-string (nnheader-header-value))
"(nobody)"))
;; Date.
(progn
number dependencies force-new))))
(push header headers))
(forward-line 1))
- (error
- (gnus-error 4 "Strange nov line (%d)"
- (count-lines (point-min) (point)))))
+ ;(error
+ ; (gnus-error 4 "Strange nov line (%d)"
+ ; (count-lines (point-min) (point))))
+ )
(forward-line 1))
;; A common bug in inn is that if you have posted an article and
;; then retrieves the active file, it will answer correctly --
(gnus-summary-remove-process-mark article)
(when (gnus-summary-display-article article)
(save-excursion
- (nnheader-temp-write nil
+ (with-temp-buffer
(insert-buffer-substring gnus-original-article-buffer)
;; Remove some headers that may lead nndoc to make
;; the wrong guess.
(interactive)
;; Replace the article.
(let ((buf (current-buffer)))
- (nnheader-temp-write nil
+ (with-temp-buffer
(insert-buffer buf)
(if (and (not read-only)
(not (gnus-request-replace-article
(message-narrow-to-head)
(let ((head (buffer-string))
header)
- (nnheader-temp-write nil
+ (with-temp-buffer
(insert (format "211 %d Article retrieved.\n"
(cdr gnus-article-current)))
(insert head)
(gnus-summary-select-article t t nil current-article))
(set-buffer gnus-original-article-buffer)
(let ((buf (format "%s" (buffer-string))))
- (nnheader-temp-write nil
+ (with-temp-buffer
(insert buf)
(goto-char (point-min))
(if (re-search-forward "^References: " nil t)
(when (gnus-buffer-exists-p buf)
(kill-buffer buf))))
-(if (fboundp 'point-at-bol)
- (fset 'gnus-point-at-bol 'point-at-bol)
+(cond
+ ((fboundp 'point-at-bol)
+ (fset 'gnus-point-at-bol 'point-at-bol))
+ ((fboundp 'line-beginning-position)
+ (fset 'gnus-point-at-bol 'line-beginning-position))
+ (t
(defun gnus-point-at-bol ()
"Return point at the beginning of the line."
(let ((p (point)))
(beginning-of-line)
(prog1
(point)
- (goto-char p)))))
-
-(if (fboundp 'point-at-eol)
- (fset 'gnus-point-at-eol 'point-at-eol)
+ (goto-char p))))))
+
+(cond
+ ((fboundp 'point-at-eol)
+ (fset 'gnus-point-at-eol 'point-at-eol))
+ ((fboundp 'line-end-position)
+ (fset 'gnus-point-at-eol 'line-end-position))
+ (t
(defun gnus-point-at-eol ()
"Return point at the end of the line."
(let ((p (point)))
(end-of-line)
(prog1
(point)
- (goto-char p)))))
+ (goto-char p))))))
(defun gnus-delete-first (elt list)
"Delete by side effect the first occurrence of ELT as a member of LIST."
(grape "#b264cc" "#cf7df")
(labia "#cc64c2" "#fd7dff")
(berry "#cc6485" "#ff7db5")
+ (dino "#cc6485" "#ff7db5")
(neutral "#b4b4b4" "#878787")
(september "#bf9900" "#ffcc00"))
"Color alist used for the Gnus logo.")
-(defcustom gnus-xmas-logo-color-style 'moss
+(defcustom gnus-xmas-logo-color-style 'dino
"*Color styles used for the Gnus logo."
:type '(choice (const flame) (const pine) (const moss)
(const irish) (const sky) (const tin)
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "0.3"
+(defconst gnus-version-number "0.4"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number)
(defface gnus-splash-face
'((((class color)
(background dark))
- (:foreground "ForestGreen"))
+ (:foreground "Brown"))
(((class color)
(background light))
- (:foreground "ForestGreen"))
+ (:foreground "Brown"))
(t
()))
- "Level 1 newsgroup face.")
+ "Face of the splash screen.")
(defun gnus-splash ()
(save-excursion
(cdr package)))))
'(("metamail" metamail-buffer)
("info" Info-goto-node)
- ("hexl" hexl-hex-string-to-integer)
("pp" pp pp-to-string pp-eval-expression)
+ ("qp" quoted-printable-decode-region quoted-printable-decode-string)
+ ("mm-decode" mm-decode-words-region mm-decode-words-string)
("ps-print" ps-print-preprint)
("mail-extr" mail-extract-address-components)
("browse-url" browse-url)
make-char-table set-char-table-range font-create-object
x-color-values widget-make-intangible error-message-string
w3-form-encode-xwfu gnus-mule-get-coding-system
- decode-coding-string mail-aliases-setup))
+ decode-coding-string mail-aliases-setup
+ mm-copy-tree url-view-url w3-prepare-buffer))
(maybe-bind '(global-face-data
mark-active transient-mark-mode mouse-selection-click-count
mouse-selection-click-count-buffer buffer-display-table
font-lock-defaults user-full-name user-login-name
gnus-newsgroup-name gnus-article-x-face-too-ugly
mail-mode-hook enable-multibyte-characters
- adaptive-fill-first-line-regexp adaptive-fill-regexp)))
+ adaptive-fill-first-line-regexp adaptive-fill-regexp
+ url-current-mime-headers)))
(maybe-bind '(mail-mode-hook
enable-multibyte-characters browse-url-browser-function
- adaptive-fill-first-line-regexp adaptive-fill-regexp))
+ adaptive-fill-first-line-regexp adaptive-fill-regexp
+ url-current-mime-headers))
(maybe-fbind '(color-instance-rgb-components
make-color-instance color-instance-name specifier-instance
device-type device-class get-popup-menu-response event-object
device-on-window-system-p make-gui-button Info-goto-node
pp-to-string color-name
gnus-mule-get-coding-system decode-coding-string
- mail-aliases-setup)))
+ mail-aliases-setup
+ mm-copy-tree url-view-url w3-prepare-buffer
+ char-int mule-write-region-no-coding-system)))
(setq load-path (cons "." load-path))
(require 'custom)
(when (and (file-exists-p file)
(file-readable-p file)
(file-regular-p file))
- (nnheader-temp-write nil
+ (with-temp-buffer
(nnheader-insert-file-contents file)
(goto-char (point-min))
(looking-at message-unix-mail-delimiter))))
(goto-char (point-min)))
(defun message-narrow-to-head ()
- "Narrow the buffer to the head of the message."
+ "Narrow the buffer to the head of the message.
+Point is left at the beginning of the narrowed-to region."
(widen)
(narrow-to-region
(goto-char (point-min))
(let ((max 988)
(cut 4)
refs)
- (nnheader-temp-write nil
+ (with-temp-buffer
(insert references)
(goto-char (point-min))
(while (re-search-forward "<[^>]+>" nil t)
(defun message-wash-subject (subject)
"Remove junk like \"Re:\", \"(fwd)\", etc. that was added to the subject by previous forwarders, replyers, etc."
- (nnheader-temp-write nil
+ (with-temp-buffer
(insert-string subject)
(goto-char (point-min))
;; strip Re/Fwd stuff off the beginning
--- /dev/null
+;;; mm-decode.el --- Function for decoding MIME things
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; This file is not yet 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 'base64)
+(require 'qp)
+(require 'nnheader)
+
+(defvar mm-charset-regexp (concat "[^" "][\000-\040()<>@,\;:\\\"/?.=" "]+"))
+
+(defvar mm-encoded-word-regexp
+ (concat "=\\?\\(" mm-charset-regexp "\\)\\?\\(B\\|Q\\)\\?"
+ "\\([!->@-~]+\\)\\?="))
+
+(defun mm-decode-words-region (start end)
+ "Decode MIME-encoded words in region between START and END."
+ (interactive "r")
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ ;; Remove whitespace between encoded words.
+ (while (re-search-forward
+ (concat "\\(" mm-encoded-word-regexp "\\)"
+ "\\(\n?[ \t]\\)+"
+ "\\(" mm-encoded-word-regexp "\\)")
+ nil t)
+ (delete-region (goto-char (match-end 1)) (match-beginning 6)))
+ ;; Decode the encoded words.
+ (goto-char (point-min))
+ (while (re-search-forward mm-encoded-word-regexp nil t)
+ (insert (mm-decode-word
+ (prog1
+ (match-string 0)
+ (delete-region (match-beginning 0) (match-end 0)))))))))
+
+(defun mm-decode-words-string (string)
+ "Decode the quoted-printable-encoded STRING and return the results."
+ (with-temp-buffer
+ (insert string)
+ (inline
+ (mm-decode-words-region (point-min) (point-max)))
+ (buffer-string)))
+
+(defun mm-decode-word (word)
+ "Decode WORD and return it if it is an encoded word.
+Return WORD if not."
+ (if (not (string-match mm-encoded-word-regexp word))
+ word
+ (or
+ (condition-case nil
+ (mm-decode-text
+ (match-string 1 word)
+ (upcase (match-string 2 word))
+ (match-string 3 word))
+ (error word))
+ word)))
+
+(defun mm-decode-text (charset encoding string)
+ "Decode STRING as an encoded text.
+Valid ENCODINGs are \"B\" and \"Q\".
+If your Emacs implementation can't decode CHARSET, it returns nil."
+ (let ((cs (mm-charset-to-coding-system charset)))
+ (when cs
+ (decode-coding-string
+ (cond
+ ((equal "B" encoding)
+ (base64-decode string))
+ ((equal "Q" encoding)
+ (quoted-printable-decode-string
+ (nnheader-replace-chars-in-string string ?_ ? )))
+ (t (error "Invalid encoding: %s" encoding)))
+ cs))))
+
+(defvar mm-charset-coding-system-alist
+ (let ((rest
+ '((us-ascii . iso-8859-1)
+ (gb2312 . cn-gb-2312)
+ (iso-2022-jp-2 . iso-2022-7bit-ss2)
+ (x-ctext . ctext)))
+ dest)
+ (while rest
+ (let ((pair (car rest)))
+ (unless (coding-system-p (car pair))
+ (setq dest (cons pair dest))))
+ (setq rest (cdr rest)))
+ dest)
+ "Charset/coding system alist.")
+
+(defun mm-charset-to-coding-system (charset &optional lbt)
+ "Return coding-system corresponding to CHARSET.
+CHARSET is a symbol naming a MIME charset.
+If optional argument LBT (`unix', `dos' or `mac') is specified, it is
+used as the line break code type of the coding system."
+ (when (stringp charset)
+ (setq charset (intern (downcase charset))))
+ (setq charset
+ (or (cdr (assq charset mm-charset-coding-system-alist))
+ charset))
+ (when lbt
+ (setq charset (intern (format "%s-%s" charset lbt))))
+ (when (memq charset (coding-system-list))
+ charset))
+
+(provide 'mm-decode)
+
+;; qp.el ends here
(let ((gnus-verbose-backends nil)
(buf (current-buffer))
article file)
- (nnheader-temp-write nil
+ (with-temp-buffer
(insert-buffer buf)
(setq article (nndraft-request-accept-article
group (nnoo-current-server 'nndraft) t 'noinsert))
\f
-(autoload 'gnus-encode-coding-string "gnus-ems")
-
;;; Interface functions.
(nnoo-define-basics nneething)
(setq files (cdr files)))
(when (and touched
(not nneething-read-only))
- (nnheader-temp-write map-file
+ (with-temp-file map-file
(insert "(setq nneething-map '")
(gnus-prin1 nneething-map)
(insert ")\n(setq nneething-active '")
(defun nnfolder-group-pathname (group)
"Make pathname for GROUP."
- (setq group (gnus-encode-coding-string group nnmail-pathname-coding-system))
+ (setq group (encode-coding-string group nnmail-pathname-coding-system))
(let ((dir (file-name-as-directory (expand-file-name nnfolder-directory))))
;; If this file exists, we use it directly.
(if (or nnmail-use-long-file-names
(nngateway-open-server server))
;; Rewrite the header.
(let ((buf (current-buffer)))
- (nnheader-temp-write nil
+ (with-temp-buffer
(insert-buffer-substring buf)
(message-narrow-to-head)
(funcall nngateway-header-transformation nngateway-address)
(autoload 'cancel-function-timers "timers")
(autoload 'gnus-point-at-eol "gnus-util")
(autoload 'gnus-delete-line "gnus-util")
- (autoload 'gnus-buffer-live-p "gnus-util")
- (autoload 'gnus-encode-coding-string "gnus-ems"))
+ (autoload 'gnus-buffer-live-p "gnus-util"))
;;; Header access macros.
(erase-buffer))
(current-buffer))
-(defmacro nnheader-temp-write (file &rest forms)
- "Create a new buffer, evaluate FORMS there, and write the buffer to FILE.
-Return the value of FORMS.
-If FILE is nil, just evaluate FORMS and don't save anything.
-If FILE is t, return the buffer contents as a string."
- (let ((temp-file (make-symbol "temp-file"))
- (temp-buffer (make-symbol "temp-buffer"))
- (temp-results (make-symbol "temp-results")))
- `(save-excursion
- (let* ((,temp-file ,file)
- (default-major-mode 'fundamental-mode)
- (,temp-buffer
- (set-buffer
- (get-buffer-create
- (generate-new-buffer-name " *nnheader temp*"))))
- ,temp-results)
- (unwind-protect
- (progn
- (setq ,temp-results (progn ,@forms))
- (cond
- ;; Don't save anything.
- ((null ,temp-file)
- ,temp-results)
- ;; Return the buffer contents.
- ((eq ,temp-file t)
- (set-buffer ,temp-buffer)
- (buffer-string))
- ;; Save a file.
- (t
- (set-buffer ,temp-buffer)
- ;; Make sure the directory where this file is
- ;; to be saved exists.
- (when (not (file-directory-p
- (file-name-directory ,temp-file)))
- (make-directory (file-name-directory ,temp-file) t))
- ;; Save the file.
- (write-region (point-min) (point-max)
- ,temp-file nil 'nomesg)
- ,temp-results)))
- ;; Kill the buffer.
- (when (buffer-name ,temp-buffer)
- (kill-buffer ,temp-buffer)))))))
-
-(put 'nnheader-temp-write 'lisp-indent-function 1)
-(put 'nnheader-temp-write 'edebug-form-spec '(form body))
-
(defvar jka-compr-compression-info-list)
(defvar nnheader-numerical-files
(if (boundp 'jka-compr-compression-info-list)
(concat dir group "/")
;; If not, we translate dots into slashes.
(concat dir
- (gnus-encode-coding-string
+ (encode-coding-string
(nnheader-replace-chars-in-string group ?. ?/)
nnheader-pathname-coding-system)
"/")))
;; Remove NOV lines of articles that are marked as read.
(when (and (file-exists-p (nnkiboze-nov-file-name))
nnkiboze-remove-read-articles)
- (nnheader-temp-write (nnkiboze-nov-file-name)
+ (with-temp-file (nnkiboze-nov-file-name)
(let ((cur (current-buffer)))
(nnheader-insert-file-contents (nnkiboze-nov-file-name))
(goto-char (point-min))
;; Load the kiboze newsrc file for this group.
(when (file-exists-p newsrc-file)
(load newsrc-file))
- (nnheader-temp-write nov-file
+ (with-temp-file nov-file
(when (file-exists-p nov-file)
(insert-file-contents nov-file))
(setq nov-buffer (current-buffer))
(gnus-message 3 "nnkiboze: Checking %s...done" (caar newsrc))
(setq newsrc (cdr newsrc))))
;; We save the kiboze newsrc for this group.
- (nnheader-temp-write newsrc-file
+ (with-temp-file newsrc-file
(insert "(setq nnkiboze-newsrc '")
(gnus-prin1 nnkiboze-newsrc)
(insert ")\n")))
(eval-and-compile
(autoload 'gnus-error "gnus-util")
- (autoload 'gnus-buffer-live-p "gnus-util")
- (autoload 'gnus-encode-coding-string "gnus-ems"))
+ (autoload 'gnus-buffer-live-p "gnus-util"))
(defgroup nnmail nil
"Reading mail with Gnus."
(concat dir group "/")
;; If not, we translate dots into slashes.
(concat dir
- (gnus-encode-coding-string
+ (encode-coding-string
(nnheader-replace-chars-in-string group ?. ?/)
nnmail-pathname-coding-system)
"/")))
"Save GROUP-ASSOC in ACTIVE-FILE."
(let ((coding-system-for-write nnmail-active-file-coding-system))
(when file-name
- (nnheader-temp-write file-name
+ (with-temp-file file-name
(nnmail-generate-active group-assoc)))))
(defun nnmail-generate-active (alist)
(insert (format "Xref: %s" (system-name)))
(while group-alist
(insert (format " %s:%d"
- (gnus-encode-coding-string (caar group-alist)
+ (encode-coding-string (caar group-alist)
nnmail-pathname-coding-system)
(cdar group-alist)))
(setq group-alist (cdr group-alist)))
(expand-file-name nnmh-toplev))))
dir)
(nnheader-replace-chars-in-string
- (gnus-decode-coding-string (substring dir (match-end 0))
- nnmail-pathname-coding-system)
+ (decode-coding-string (substring dir (match-end 0))
+ nnmail-pathname-coding-system)
?/ ?.))
(apply 'max files)
(apply 'min files)))))))
(setq articles (sort articles (lambda (art1 art2)
(> (car art1) (car art2)))))
;; Finally write this list back to the .nnmh-articles file.
- (nnheader-temp-write nnmh-file
+ (with-temp-file nnmh-file
(insert ";; Gnus article active file for " group "\n\n")
(insert "(setq nnmh-newsgroup-articles '")
(gnus-prin1 articles)
((not (file-exists-p file))
(nnheader-report 'nnml "File %s does not exist" file))
(t
- (nnheader-temp-write file
+ (with-temp-file file
(nnheader-insert-file-contents file)
(nnmail-replace-status name value))
t))))
(or force
nnsoup-group-alist-touched))
(setq nnsoup-group-alist-touched nil)
- (nnheader-temp-write nnsoup-active-file
+ (with-temp-file nnsoup-active-file
(gnus-prin1 `(setq nnsoup-group-alist ',nnsoup-group-alist))
(insert "\n")
(gnus-prin1 `(setq nnsoup-current-prefix ,nnsoup-current-prefix))
The authinfo login name is taken from the user's login name and the
password contained in '~/.nntp-authinfo'."
(when (file-exists-p "~/.nntp-authinfo")
- (nnheader-temp-write nil
+ (with-temp-buffer
(insert-file-contents "~/.nntp-authinfo")
(goto-char (point-min))
(nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name))
(defun nnweb-read-overview (group)
"Read the overview of GROUP and build the map."
(when (file-exists-p (nnweb-overview-file group))
- (nnheader-temp-write nil
+ (with-temp-buffer
(nnheader-insert-file-contents (nnweb-overview-file group))
(goto-char (point-min))
(let (header)
(defun nnweb-write-overview (group)
"Write the overview file for GROUP."
- (nnheader-temp-write (nnweb-overview-file group)
+ (with-temp-file (nnweb-overview-file group)
(let ((articles nnweb-articles))
(while articles
(nnheader-insert-nov (cadr (pop articles)))))))
(defun nnweb-write-active ()
"Save the active file."
- (nnheader-temp-write (nnheader-concat nnweb-directory "active")
+ (with-temp-file (nnheader-concat nnweb-directory "active")
(prin1 `(setq nnweb-group-alist ',nnweb-group-alist) (current-buffer))))
(defun nnweb-read-active ()
--- /dev/null
+;;; qp.el --- Quoted-printable functions
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; 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:
+
+(defvar quoted-printable-encoding-characters
+ (mapcar 'identity "0123456789ABCDEF"))
+
+(defun quoted-printable-decode-region (from to)
+ "Decode quoted-printable in the region between FROM and TO."
+ (interactive "r")
+ (save-excursion
+ (goto-char from)
+ (while (search-forward "=" to t)
+ (cond ((eq (following-char) ?\n)
+ (delete-char -1)
+ (delete-char 1))
+ ((and
+ (memq (following-char) quoted-printable-encoding-characters)
+ (memq (char-after (1+ (point)))
+ quoted-printable-encoding-characters))
+ (subst-char-in-region
+ (1- (point)) (point) ?=
+ (string-to-number
+ (buffer-substring (point) (+ 2 (point)))
+ 16))
+ (delete-char 2))
+ ((looking-at "=")
+ (delete-char 1))
+ ((message "Malformed MIME quoted-printable message"))))))
+
+(defun quoted-printable-decode-string (string)
+ "Decode the quoted-printable-encoded STRING and return the results."
+ (with-temp-buffer
+ (insert string)
+ (quoted-printable-decode-region (point-min) (point-max))
+ (buffer-string)))
+
+(defun quoted-printable-encode-region (from to)
+ "QP-encode the region between FROM and TO."
+ (interactive "r")
+ (save-excursion
+ (save-restriction
+ (narrow-to-region from to)
+ (goto-char (point-min))
+ (while (re-search-forward "[\000-\007\013\015-\037\200-\237=]" nil t)
+ (insert
+ (prog1
+ (format "=%x" (char-after (1- (point))))
+ (delete-char -1))))
+ ;; Fold long lines.
+ (goto-char (point-min))
+ (end-of-line)
+ (while (> (current-column) 72)
+ (beginning-of-line)
+ (forward-char 72)
+ (search-backward "=" (- (point) 2) t)
+ (insert "=\n")
+ (end-of-line)))))
+
+(defun quoted-printable-encode-string (string)
+ "QP-encode STRING and return the results."
+ (with-temp-buffer
+ (insert string)
+ (quoted-printable-encode-region (point-min) (point-max))
+ (buffer-string)))
+
+(provide 'qp)
+
+;; qp.el ends here
\input texinfo @c -*-texinfo-*-
@setfilename gnus
-@settitle Pterodactyl Gnus 0.3 Manual
+@settitle Pterodactyl Gnus 0.4 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
@tex
@titlepage
-@title Pterodactyl Gnus 0.3 Manual
+@title Pterodactyl Gnus 0.4 Manual
@author by Lars Magne Ingebrigtsen
@page
spool or your mbox file. All at the same time, if you want to push your
luck.
-This manual corresponds to Pterodactyl Gnus 0.3.
+This manual corresponds to Pterodactyl Gnus 0.4.
@end ifinfo
\input texinfo @c -*-texinfo-*-
@setfilename message
-@settitle Pterodactyl Message 0.3 Manual
+@settitle Pterodactyl Message 0.4 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
@tex
@titlepage
-@title Pterodactyl Message 0.3 Manual
+@title Pterodactyl Message 0.4 Manual
@author by Lars Magne Ingebrigtsen
@page
* Key Index:: List of Message mode keys.
@end menu
-This manual corresponds to Pterodactyl Message 0.3. Message is
+This manual corresponds to Pterodactyl Message 0.4. Message is
distributed with the Gnus distribution bearing the same version number
as this manual has.
projects / gnus / commitdiff