From 1626a196f4c06639aaf46dc4a6a0901b7b6e9b5c Mon Sep 17 00:00:00 2001 From: Lars Magne Ingebrigtsen Date: Sat, 29 Aug 1998 20:21:23 +0000 Subject: [PATCH] *** empty log message *** --- Makefile.in | 6 +-- lisp/ChangeLog | 34 ++++++++++++ lisp/gnus-agent.el | 18 +++---- lisp/gnus-art.el | 70 +++++++------------------ lisp/gnus-cache.el | 2 +- lisp/gnus-dup.el | 2 +- lisp/gnus-ems.el | 39 +------------- lisp/gnus-group.el | 2 +- lisp/gnus-nocem.el | 6 +-- lisp/gnus-score.el | 4 +- lisp/gnus-soup.el | 4 +- lisp/gnus-start.el | 2 +- lisp/gnus-sum.el | 46 +++++++--------- lisp/gnus-util.el | 22 +++++--- lisp/gnus-xmas.el | 3 +- lisp/gnus.el | 11 ++-- lisp/lpath.el | 13 +++-- lisp/message.el | 9 ++-- lisp/mm-decode.el | 128 +++++++++++++++++++++++++++++++++++++++++++++ lisp/nndraft.el | 2 +- lisp/nneething.el | 4 +- lisp/nnfolder.el | 2 +- lisp/nngateway.el | 2 +- lisp/nnheader.el | 51 +----------------- lisp/nnkiboze.el | 6 +-- lisp/nnmail.el | 9 ++-- lisp/nnmh.el | 6 +-- lisp/nnml.el | 2 +- lisp/nnsoup.el | 2 +- lisp/nntp.el | 2 +- lisp/nnweb.el | 6 +-- lisp/qp.el | 90 +++++++++++++++++++++++++++++++ texi/gnus.texi | 6 +-- texi/message.texi | 6 +-- 34 files changed, 380 insertions(+), 237 deletions(-) create mode 100644 lisp/mm-decode.el create mode 100644 lisp/qp.el diff --git a/Makefile.in b/Makefile.in index a30ae8dfa..82fd42054 100644 --- a/Makefile.in +++ b/Makefile.in @@ -5,7 +5,7 @@ srcdir = @srcdir@ @SET_MAKE@ EMACS = @EMACS@ -XEMACS = xemacs +XEMACS = xemacs21 all: lick info @@ -35,7 +35,7 @@ elclean: rm lisp/*.elc x: - make EMACS=xemacs + make EMACS=xemacs21 distclean: make clean @@ -44,7 +44,7 @@ distclean: 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 diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3fcb5ee27..cbb88c0a8 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,37 @@ +Sat Aug 29 22:20:39 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v0.4 is released. + +1998-08-29 20:53:29 Lars Magne Ingebrigtsen + + * 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 * gnus.el: Gnus v0.3 is released. diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index be03a4d41..65bc02bde 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -127,7 +127,7 @@ If nil, only read articles will be expired." (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)) @@ -427,7 +427,7 @@ be a select method." (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)))) ;;; @@ -537,7 +537,7 @@ the actual number of articles toggled is returned." (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)) @@ -662,7 +662,7 @@ the actual number of articles toggled is returned." ;; 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) @@ -745,7 +745,7 @@ the actual number of articles toggled is returned." 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)))) @@ -837,9 +837,9 @@ the actual number of articles toggled is returned." (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)) @@ -1084,7 +1084,7 @@ The following commands are available: "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) diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 4eab8db46..7c44773cd 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -272,7 +272,6 @@ be fed to `format-time-string'." :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")) @@ -958,72 +957,41 @@ characters to translate to." (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. @@ -1231,7 +1199,7 @@ Put point at the beginning of the signature separator." (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 @@ -2189,7 +2157,7 @@ Provided for backwards compatibility." (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. @@ -3135,7 +3103,7 @@ specified by `gnus-button-alist'." (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)) diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index 7f03b707f..bce2f5431 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -595,7 +595,7 @@ $ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache" (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)) diff --git a/lisp/gnus-dup.el b/lisp/gnus-dup.el index 6958f02d7..b28963982 100644 --- a/lisp/gnus-dup.el +++ b/lisp/gnus-dup.el @@ -98,7 +98,7 @@ seen in the same session." "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)) diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index 0e9576257..34625a2e1 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -45,9 +45,6 @@ (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) @@ -78,12 +75,6 @@ (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 @@ -95,20 +86,6 @@ ((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)))) @@ -180,8 +157,6 @@ (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 @@ -234,7 +209,7 @@ (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 @@ -245,7 +220,7 @@ (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) @@ -259,16 +234,6 @@ (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: diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 612be02ac..6eddfca7f 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -2155,7 +2155,7 @@ score file entries for articles to include in the group." (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))))) diff --git a/lisp/gnus-nocem.el b/lisp/gnus-nocem.el index d678531dc..66974ee49 100644 --- a/lisp/gnus-nocem.el +++ b/lisp/gnus-nocem.el @@ -146,7 +146,7 @@ matches an previously scanned and verified nocem message." (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 @@ -302,13 +302,13 @@ matches an previously scanned and verified nocem message." "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 () diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index 8cff072ec..f2c3b3a8f 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -2209,7 +2209,7 @@ SCORE is the score to add." ;; 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) @@ -2625,7 +2625,7 @@ Destroys the current buffer." (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) diff --git a/lisp/gnus-soup.el b/lisp/gnus-soup.el index 08f817610..71345c9a7 100644 --- a/lisp/gnus-soup.el +++ b/lisp/gnus-soup.el @@ -422,7 +422,7 @@ file. The vector contain three strings, [prefix name encoding]." "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)) @@ -443,7 +443,7 @@ file. The vector contain three strings, [prefix name encoding]." (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" diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 97ab9b866..f13d90257 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -2531,7 +2531,7 @@ If FORCE is non-nil, the .newsrc file is read." (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") diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 5e5c6ea51..e2d17c94b 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -663,18 +663,7 @@ is not run if `gnus-visual' is nil." :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) @@ -1395,6 +1384,9 @@ increase the score of each group you read." "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 @@ -1494,6 +1486,9 @@ increase the score of each group you read." ["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] @@ -3062,10 +3057,8 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (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 @@ -4407,15 +4400,13 @@ The resulting hash table is returned, or nil if no Xrefs were found." (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 @@ -4535,9 +4526,10 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')." 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 -- @@ -6513,7 +6505,7 @@ Obeys the standard process/prefix convention." (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. @@ -7318,7 +7310,7 @@ groups." (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 @@ -7336,7 +7328,7 @@ groups." (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) @@ -8150,7 +8142,7 @@ is non-nil or the Subject: of both articles are the same." (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) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index ac066e508..069e6a631 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -106,25 +106,33 @@ (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." diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index 00fc58356..23eb31cfe 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -52,11 +52,12 @@ automatically." (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) diff --git a/lisp/gnus.el b/lisp/gnus.el index 947565e98..f04f88eb2 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -250,7 +250,7 @@ is restarted, and sometimes reloaded." :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) @@ -637,13 +637,13 @@ be set in `.emacs' instead." (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 @@ -1569,8 +1569,9 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") (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) diff --git a/lisp/lpath.el b/lisp/lpath.el index d41172b44..3eccac9de 100644 --- a/lisp/lpath.el +++ b/lisp/lpath.el @@ -29,17 +29,20 @@ 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 @@ -53,7 +56,9 @@ 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) diff --git a/lisp/message.el b/lisp/message.el index a7e5cd47e..15c9b5b41 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -1011,7 +1011,7 @@ The cdr of ech entry is a function for applying the face to a region.") (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)))) @@ -1111,7 +1111,8 @@ Return the number of headers removed." (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)) @@ -3055,7 +3056,7 @@ Headers already prepared in the buffer are not modified." (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) @@ -3583,7 +3584,7 @@ header line with the old Message-ID." (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 diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el new file mode 100644 index 000000000..26dd8323c --- /dev/null +++ b/lisp/mm-decode.el @@ -0,0 +1,128 @@ +;;; mm-decode.el --- Function for decoding MIME things +;; Copyright (C) 1998 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen +;; 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 diff --git a/lisp/nndraft.el b/lisp/nndraft.el index f7182a593..39c6e2875 100644 --- a/lisp/nndraft.el +++ b/lisp/nndraft.el @@ -156,7 +156,7 @@ (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)) diff --git a/lisp/nneething.el b/lisp/nneething.el index 7da546658..6aaa52963 100644 --- a/lisp/nneething.el +++ b/lisp/nneething.el @@ -68,8 +68,6 @@ If this variable is nil, no files will be excluded.") -(autoload 'gnus-encode-coding-string "gnus-ems") - ;;; Interface functions. (nnoo-define-basics nneething) @@ -243,7 +241,7 @@ If this variable is nil, no files will be excluded.") (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 '") diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el index db9666b5f..5016121a2 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -797,7 +797,7 @@ deleted. Point is left where the deleted region was." (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 diff --git a/lisp/nngateway.el b/lisp/nngateway.el index 2139885af..41dc00a11 100644 --- a/lisp/nngateway.el +++ b/lisp/nngateway.el @@ -54,7 +54,7 @@ parameter -- the gateway address.") (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) diff --git a/lisp/nnheader.el b/lisp/nnheader.el index e0de0a4af..b813e8c9c 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -61,8 +61,7 @@ on your system, you could say something like: (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. @@ -499,52 +498,6 @@ the line could be found." (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) @@ -701,7 +654,7 @@ without formatting." (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) "/"))) diff --git a/lisp/nnkiboze.el b/lisp/nnkiboze.el index c47a10d39..b3e8f7dbd 100644 --- a/lisp/nnkiboze.el +++ b/lisp/nnkiboze.el @@ -136,7 +136,7 @@ ;; 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)) @@ -230,7 +230,7 @@ Finds out what articles are to be part of the nnkiboze groups." ;; 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)) @@ -318,7 +318,7 @@ Finds out what articles are to be part of the nnkiboze groups." (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"))) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index bc8d1f5d5..c7193e5d9 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -35,8 +35,7 @@ (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." @@ -514,7 +513,7 @@ parameter. It should return nil, `warn' or `delete'." (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) "/"))) @@ -705,7 +704,7 @@ nn*-request-list should have been called before calling this function." "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) @@ -1202,7 +1201,7 @@ Return the number of characters in the body." (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))) diff --git a/lisp/nnmh.el b/lisp/nnmh.el index 8aafd7d60..6dcdb5d29 100644 --- a/lisp/nnmh.el +++ b/lisp/nnmh.el @@ -229,8 +229,8 @@ (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))))))) @@ -533,7 +533,7 @@ (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) diff --git a/lisp/nnml.el b/lisp/nnml.el index e7a1df967..f4da479ee 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -469,7 +469,7 @@ all. This may very well take some time.") ((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)))) diff --git a/lisp/nnsoup.el b/lisp/nnsoup.el index e7641509a..4ccb28c2b 100644 --- a/lisp/nnsoup.el +++ b/lisp/nnsoup.el @@ -376,7 +376,7 @@ backend for the messages.") (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)) diff --git a/lisp/nntp.el b/lisp/nntp.el index 487c72d21..863b655cd 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -796,7 +796,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the 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)) diff --git a/lisp/nnweb.el b/lisp/nnweb.el index 5a673cd4b..96784c2cf 100644 --- a/lisp/nnweb.el +++ b/lisp/nnweb.el @@ -219,7 +219,7 @@ and `altavista'.") (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) @@ -233,7 +233,7 @@ and `altavista'.") (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))))))) @@ -254,7 +254,7 @@ and `altavista'.") (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 () diff --git a/lisp/qp.el b/lisp/qp.el new file mode 100644 index 000000000..1ef4a77a7 --- /dev/null +++ b/lisp/qp.el @@ -0,0 +1,90 @@ +;;; qp.el --- Quoted-printable functions +;; Copyright (C) 1998 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen +;; 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 diff --git a/texi/gnus.texi b/texi/gnus.texi index f9265d439..3ee37e1b0 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,7 +1,7 @@ \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 @@ -318,7 +318,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Pterodactyl Gnus 0.3 Manual +@title Pterodactyl Gnus 0.4 Manual @author by Lars Magne Ingebrigtsen @page @@ -354,7 +354,7 @@ can be gotten by any nefarious means you can think of---@sc{nntp}, local spool or your mbox file. All at the same time, if you want to push your luck. -This manual corresponds to Pterodactyl Gnus 0.3. +This manual corresponds to Pterodactyl Gnus 0.4. @end ifinfo diff --git a/texi/message.texi b/texi/message.texi index 9138ef410..ed58f2598 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \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 @@ -42,7 +42,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Pterodactyl Message 0.3 Manual +@title Pterodactyl Message 0.4 Manual @author by Lars Magne Ingebrigtsen @page @@ -83,7 +83,7 @@ Message mode buffers. * Key Index:: List of Message mode keys. @end menu -This manual corresponds to Pterodactyl Message 0.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. -- 2.25.1