*** pub/pgnus/lisp/binhex.el Tue Oct 20 00:27:13 1998 --- pgnus/lisp/binhex.el Tue Oct 20 00:27:04 1998 *************** *** 0 **** --- 1,316 ---- + ;;; binhex.el -- elisp native binhex decode + ;; Copyright (c) 1998 by Shenghuo Zhu + + ;; Author: Shenghuo Zhu + ;; Create Date: Oct 1, 1998 + ;; $Revision: 1.2 $ + ;; Time-stamp: + ;; Keywords: binhex + + ;; This file is not part of GNU Emacs, but the same permissions + ;; apply. + + ;; 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: + + (if (not (fboundp 'char-int)) + (fset 'char-int 'identity)) + + (defvar binhex-decoder-program "hexbin" + "*Non-nil value should be a string that names a uu decoder. + The program should expect to read binhex data on its standard + input and write the converted data to its standard output.") + + (defvar binhex-decoder-switches '("-d") + "*List of command line flags passed to the command named by binhex-decoder-program.") + + (defconst binhex-alphabet-decoding-alist + '(( ?\! . 0) ( ?\" . 1) ( ?\# . 2) ( ?\$ . 3) ( ?\% . 4) ( ?\& . 5) + ( ?\' . 6) ( ?\( . 7) ( ?\) . 8) ( ?\* . 9) ( ?\+ . 10) ( ?\, . 11) + ( ?\- . 12) ( ?0 . 13) ( ?1 . 14) ( ?2 . 15) ( ?3 . 16) ( ?4 . 17) + ( ?5 . 18) ( ?6 . 19) ( ?8 . 20) ( ?9 . 21) ( ?@ . 22) ( ?A . 23) + ( ?B . 24) ( ?C . 25) ( ?D . 26) ( ?E . 27) ( ?F . 28) ( ?G . 29) + ( ?H . 30) ( ?I . 31) ( ?J . 32) ( ?K . 33) ( ?L . 34) ( ?M . 35) + ( ?N . 36) ( ?P . 37) ( ?Q . 38) ( ?R . 39) ( ?S . 40) ( ?T . 41) + ( ?U . 42) ( ?V . 43) ( ?X . 44) ( ?Y . 45) ( ?Z . 46) ( ?\[ . 47) + ( ?\` . 48) ( ?a . 49) ( ?b . 50) ( ?c . 51) ( ?d . 52) ( ?e . 53) + ( ?f . 54) ( ?h . 55) ( ?i . 56) ( ?j . 57) ( ?k . 58) ( ?l . 59) + ( ?m . 60) ( ?p . 61) ( ?q . 62) ( ?r . 63))) + + (defun binhex-char-map (char) + (cdr (assq char binhex-alphabet-decoding-alist))) + + ;;;###autoload + (defconst binhex-begin-line + "^:...............................................................$") + (defconst binhex-body-line + "^[^:]...............................................................$") + (defconst binhex-end-line ":$") + + (defvar binhex-temporary-file-directory "/tmp/") + + (defun binhex-insert-char (char &optional count ignored buffer) + (condition-case nil + (progn + (insert-char char count ignored buffer) + (fset 'binhex-insert-char 'insert-char)) + (wrong-number-of-arguments + (fset 'binhex-insert-char 'binhex-xemacs-insert-char) + (binhex-insert-char char count ignored buffer)))) + + (defun binhex-xemacs-insert-char (char &optional count ignored buffer) + (if (or (null buffer) (eq buffer (current-buffer))) + (insert-char char count) + (save-excursion + (set-buffer buffer) + (insert-char char count)))) + + (defvar binhex-crc-table + [0 4129 8258 12387 16516 20645 24774 28903 + 33032 37161 41290 45419 49548 53677 57806 61935 + 4657 528 12915 8786 21173 17044 29431 25302 + 37689 33560 45947 41818 54205 50076 62463 58334 + 9314 13379 1056 5121 25830 29895 17572 21637 + 42346 46411 34088 38153 58862 62927 50604 54669 + 13907 9842 5649 1584 30423 26358 22165 18100 + 46939 42874 38681 34616 63455 59390 55197 51132 + 18628 22757 26758 30887 2112 6241 10242 14371 + 51660 55789 59790 63919 35144 39273 43274 47403 + 23285 19156 31415 27286 6769 2640 14899 10770 + 56317 52188 64447 60318 39801 35672 47931 43802 + 27814 31879 19684 23749 11298 15363 3168 7233 + 60846 64911 52716 56781 44330 48395 36200 40265 + 32407 28342 24277 20212 15891 11826 7761 3696 + 65439 61374 57309 53244 48923 44858 40793 36728 + 37256 33193 45514 41451 53516 49453 61774 57711 + 4224 161 12482 8419 20484 16421 28742 24679 + 33721 37784 41979 46042 49981 54044 58239 62302 + 689 4752 8947 13010 16949 21012 25207 29270 + 46570 42443 38312 34185 62830 58703 54572 50445 + 13538 9411 5280 1153 29798 25671 21540 17413 + 42971 47098 34713 38840 59231 63358 50973 55100 + 9939 14066 1681 5808 26199 30326 17941 22068 + 55628 51565 63758 59695 39368 35305 47498 43435 + 22596 18533 30726 26663 6336 2273 14466 10403 + 52093 56156 60223 64286 35833 39896 43963 48026 + 19061 23124 27191 31254 2801 6864 10931 14994 + 64814 60687 56684 52557 48554 44427 40424 36297 + 31782 27655 23652 19525 15522 11395 7392 3265 + 61215 65342 53085 57212 44955 49082 36825 40952 + 28183 32310 20053 24180 11923 16050 3793 7920]) + + (defun binhex-update-crc (crc char &optional count) + (if (null count) (setq count 1)) + (while (> count 0) + (setq crc (logxor (logand (lsh crc 8) 65280) + (aref binhex-crc-table + (logxor (logand (lsh crc -8) 255) + char))) + count (1- count))) + crc) + + (defun binhex-verify-crc (buffer start end) + (with-current-buffer buffer + (let ((pos start) (crc 0) (last (- end 2))) + (while (< pos last) + (setq crc (binhex-update-crc crc (char-after pos)) + pos (1+ pos))) + (if (= crc (binhex-string-big-endian (buffer-substring last end))) + nil + (error "CRC error"))))) + + (defun binhex-string-big-endian (string) + (let ((ret 0) (i 0) (len (length string))) + (while (< i len) + (setq ret (+ (lsh ret 8) (char-int (aref string i))) + i (1+ i))) + ret)) + + (defun binhex-string-little-endian (string) + (let ((ret 0) (i 0) (shift 0) (len (length string))) + (while (< i len) + (setq ret (+ ret (lsh (char-int (aref string i)) shift)) + i (1+ i) + shift (+ shift 8))) + ret)) + + (defun binhex-header (buffer) + (with-current-buffer buffer + (let ((pos (point-min)) len) + (vector + (prog1 + (setq len (char-int (char-after pos))) + (setq pos (1+ pos))) + (buffer-substring pos (setq pos (+ pos len))) + (prog1 + (setq len (char-int (char-after pos))) + (setq pos (1+ pos))) + (buffer-substring pos (setq pos (+ pos 4))) + (buffer-substring pos (setq pos (+ pos 4))) + (binhex-string-big-endian + (buffer-substring pos (setq pos (+ pos 2)))) + (binhex-string-big-endian + (buffer-substring pos (setq pos (+ pos 4)))) + (binhex-string-big-endian + (buffer-substring pos (setq pos (+ pos 4)))))))) + + (defvar binhex-last-char) + (defvar binhex-repeat) + + (defun binhex-push-char (char &optional count ignored buffer) + (cond + (binhex-repeat + (if (eq char 0) + (binhex-insert-char (setq binhex-last-char 144) 1 + ignored buffer) + (binhex-insert-char binhex-last-char (- char 1) + ignored buffer) + (setq binhex-last-char nil)) + (setq binhex-repeat nil)) + ((= char 144) + (setq binhex-repeat t)) + (t + (binhex-insert-char (setq binhex-last-char char) 1 ignored buffer)))) + + (defun binhex-decode-region (start end &optional header-only) + "Binhex decode region between START and END. + If HEADER-ONLY is non-nil only decode header and return filename." + (interactive "r") + (let ((work-buffer nil) + (counter 0) + (bits 0) (tmp t) + (lim 0) inputpos + (non-data-chars " \t\n\r:") + file-name-length data-fork-start + header + binhex-last-char binhex-repeat) + (unwind-protect + (save-excursion + (goto-char start) + (when (re-search-forward binhex-begin-line end t) + (if (boundp 'enable-multibyte-characters) + (let ((multibyte + (default-value enable-multibyte-characters))) + (setq-default enable-multibyte-characters nil) + (setq work-buffer + (generate-new-buffer " *binhex-work*")) + (setq-default enable-multibyte-characters multibyte)) + (setq work-buffer (generate-new-buffer " *binhex-work*"))) + (buffer-disable-undo work-buffer) + (beginning-of-line) + (setq bits 0 counter 0) + (while tmp + (skip-chars-forward non-data-chars end) + (setq inputpos (point)) + (end-of-line) + (setq lim (point)) + (while (and (< inputpos lim) + (setq tmp (binhex-char-map (char-after inputpos)))) + (setq bits (+ bits tmp) + counter (1+ counter) + inputpos (1+ inputpos)) + (cond ((= counter 4) + (binhex-push-char (lsh bits -16) 1 nil work-buffer) + (binhex-push-char (logand (lsh bits -8) 255) 1 nil + work-buffer) + (binhex-push-char (logand bits 255) 1 nil + work-buffer) + (setq bits 0 counter 0)) + (t (setq bits (lsh bits 6))))) + (if (null file-name-length) + (with-current-buffer work-buffer + (setq file-name-length (char-after (point-min)) + data-fork-start (+ (point-min) + file-name-length 22)))) + (if (and (null header) + (with-current-buffer work-buffer + (>= (buffer-size) data-fork-start))) + (progn + (binhex-verify-crc work-buffer + 1 data-fork-start) + (setq header (binhex-header work-buffer)) + (if header-only (setq tmp nil counter 0)))) + (setq tmp (and tmp (not (eq inputpos end))))) + (cond + ((= counter 3) + (binhex-push-char (logand (lsh bits -16) 255) 1 nil + work-buffer) + (binhex-push-char (logand (lsh bits -8) 255) 1 nil + work-buffer)) + ((= counter 2) + (binhex-push-char (logand (lsh bits -10) 255) 1 nil + work-buffer)))) + (if header-only nil + (binhex-verify-crc work-buffer + data-fork-start + (+ data-fork-start (aref header 6) 2)) + (or (markerp end) (setq end (set-marker (make-marker) end))) + (goto-char start) + (insert-buffer-substring work-buffer + data-fork-start (+ data-fork-start + (aref header 6))) + (delete-region (point) end))) + (and work-buffer (kill-buffer work-buffer))) + (if header (aref header 1)))) + + (defun binhex-decode-region-external (start end) + "Binhex decode region between START and END using external decoder" + (interactive "r") + (let ((cbuf (current-buffer)) firstline work-buffer status + (file-name (concat binhex-temporary-file-directory + (binhex-decode-region start end t) + ".data"))) + (save-excursion + (goto-char start) + (when (re-search-forward binhex-begin-line nil t) + (let ((cdir default-directory) default-process-coding-system) + (unwind-protect + (progn + (set-buffer (setq work-buffer + (generate-new-buffer " *binhex-work*"))) + (buffer-disable-undo work-buffer) + (insert-buffer-substring cbuf firstline end) + (cd binhex-temporary-file-directory) + (apply 'call-process-region + (point-min) + (point-max) + binhex-decoder-program + nil + nil + nil + binhex-decoder-switches)) + (cd cdir) (set-buffer cbuf))) + (if (and file-name (file-exists-p file-name)) + (progn + (goto-char start) + (delete-region start end) + (let (format-alist) + (insert-file-contents-literally file-name))) + (error "Can not binhex"))) + (and work-buffer (kill-buffer work-buffer)) + (condition-case () + (if file-name (delete-file file-name)) + (error)) + ))) + + (provide 'binhex) + + ;;; binhex.el ends here + + *** pub/pgnus/lisp/gnus-art.el Sun Oct 11 02:32:02 1998 --- pgnus/lisp/gnus-art.el Tue Oct 20 00:27:04 1998 *************** *** 546,551 **** --- 546,571 ---- (defvar gnus-decode-header-function 'mail-decode-encoded-word-region "Function used to decode headers.") + (defvar gnus-article-dumbquotes-map + '(("\202" . ",") + ("\203" . "f") + ("\204" . ",,") + ("\213" . "<") + ("\214" . "OE") + ("\205" . "...") + ("\221" . "`") + ("\222" . "'") + ("\223" . "``") + ("\224" . "''") + ("\225" . "*") + ("\226" . "-") + ("\227" . "-") + ("\231" . "(TM)") + ("\233" . ">") + ("\234" . "oe") + ("\264" . "'")) + "Table for MS-to-Latin1 translation.") + ;;; Internal variables (defvar gnus-article-mime-handle-alist nil) *************** *** 808,814 **** (defun article-treat-dumbquotes () "Translate M******** sm*rtq**t*s into proper text." (interactive) ! (article-translate-characters "\221\222\223\224" "`'\"\"")) (defun article-translate-characters (from to) "Translate all characters in the body of the article according to FROM and TO. --- 828,834 ---- (defun article-treat-dumbquotes () "Translate M******** sm*rtq**t*s into proper text." (interactive) ! (article-translate-strings gnus-article-dumbquotes-map)) (defun article-translate-characters (from to) "Translate all characters in the body of the article according to FROM and TO. *************** *** 828,833 **** --- 848,866 ---- (incf i)) (translate-region (point) (point-max) x))))) + (defun article-translate-strings (map) + "Translate all string in the body of the article according to MAP. + MAP is an alist where the elements are on the form (\"from\" \"to\")." + (save-excursion + (goto-char (point-min)) + (when (search-forward "\n\n" nil t) + (let ((buffer-read-only nil) + elem) + (while (setq elem (pop map)) + (save-excursion + (while (search-forward (car elem) nil t) + (replace-match (cadr elem))))))))) + (defun article-treat-overstrike () "Translate overstrikes into bold text." (interactive) *************** *** 1011,1017 **** (and type (string-match "quoted-printable" (downcase type)))) (goto-char (point-min)) (search-forward "\n\n" nil 'move) ! (quoted-printable-decode-region (point) (point-max)))))) (defun article-mime-decode-quoted-printable-buffer () "Decode Quoted-Printable in the current buffer." --- 1044,1052 ---- (and type (string-match "quoted-printable" (downcase type)))) (goto-char (point-min)) (search-forward "\n\n" nil 'move) ! (quoted-printable-decode-region (point) (point-max)) ! (when mm-default-coding-system ! (mm-decode-body mm-default-coding-system)))))) (defun article-mime-decode-quoted-printable-buffer () "Decode Quoted-Printable in the current buffer." *************** *** 1031,1036 **** --- 1066,1074 ---- ;; Hide the "header". (when (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t) (delete-region (1+ (match-beginning 0)) (match-end 0)) + ;; PGP 5 and GNU PG add a `Hash: <>' comment, hide that too + (when (looking-at "Hash:.*$") + (delete-region (point) (1+ (gnus-point-at-eol)))) (setq beg (point)) ;; Hide the actual signature. (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t) *************** *** 1733,1739 **** (defun gnus-summary-save-in-pipe (&optional command) "Pipe this article to subprocess." (setq command ! (cond ((eq command 'default) gnus-last-shell-command) (command command) (t (read-string --- 1771,1778 ---- (defun gnus-summary-save-in-pipe (&optional command) "Pipe this article to subprocess." (setq command ! (cond ((and (eq command 'default) ! gnus-last-shell-command) gnus-last-shell-command) (command command) (t (read-string *************** *** 2006,2011 **** --- 2045,2051 ---- (set-buffer (gnus-get-buffer-create name)) (gnus-article-mode) (make-local-variable 'gnus-summary-buffer) + (gnus-summary-set-local-parameters gnus-newsgroup-name) (current-buffer))))) ;; Set article window start at LINE, where LINE is the number of lines *************** *** 2138,2143 **** --- 2178,2184 ---- buffer-read-only) (unless (eq major-mode 'gnus-article-mode) (gnus-article-mode)) + (setq buffer-read-only nil) (gnus-run-hooks 'gnus-tmp-internal-hook) (gnus-run-hooks 'gnus-article-prepare-hook) (when gnus-display-mime-function *************** *** 2150,2181 **** ;;; Gnus MIME viewing functions ;;; ! (defvar gnus-mime-button-line-format "%{%([%p. %t%d%n]%)%}\n" "The following specs can be used: %t The MIME type %n The `name' parameter %d The description, if any %l The length of the encoded part ! %p The part identifier") (defvar gnus-mime-button-line-format-alist '((?t gnus-tmp-type ?s) (?n gnus-tmp-name ?s) (?d gnus-tmp-description ?s) (?p gnus-tmp-id ?s) ! (?l gnus-tmp-length ?d))) (defvar gnus-mime-button-map nil) (unless gnus-mime-button-map ! (setq gnus-mime-button-map (copy-keymap gnus-article-mode-map)) (define-key gnus-mime-button-map gnus-mouse-2 'gnus-article-push-button) ! (define-key gnus-mime-button-map "\r" 'gnus-article-press-button) ! (define-key gnus-mime-button-map "\M-\r" 'gnus-mime-view-part) ! (define-key gnus-mime-button-map "v" 'gnus-mime-view-part) ! (define-key gnus-mime-button-map "o" 'gnus-mime-save-part) ! (define-key gnus-mime-button-map "c" 'gnus-mime-copy-part) ! (define-key gnus-mime-button-map "i" 'gnus-mime-inline-part) ! (define-key gnus-mime-button-map "|" 'gnus-mime-pipe-part)) (defun gnus-mime-view-all-parts () "View all the MIME parts." --- 2191,2236 ---- ;;; Gnus MIME viewing functions ;;; ! (defvar gnus-mime-button-line-format "%{%([%p. %t%d%n]%)%}%e\n" "The following specs can be used: %t The MIME type %n The `name' parameter %d The description, if any %l The length of the encoded part ! %p The part identifier ! %e Dots if the part isn't displayed") (defvar gnus-mime-button-line-format-alist '((?t gnus-tmp-type ?s) (?n gnus-tmp-name ?s) (?d gnus-tmp-description ?s) (?p gnus-tmp-id ?s) ! (?l gnus-tmp-length ?d) ! (?e gnus-tmp-dots ?s))) ! ! (defvar gnus-mime-button-commands ! '((gnus-article-press-button "\r" "Toggle Display") ! ;(gnus-mime-view-part "\M-\r" "View Interactively...") ! (gnus-mime-view-part "v" "View Interactively...") ! (gnus-mime-save-part "o" "Save...") ! (gnus-mime-copy-part "c" "View In Buffer") ! (gnus-mime-inline-part "i" "View Inline") ! (gnus-mime-pipe-part "|" "Pipe To Command..."))) (defvar gnus-mime-button-map nil) (unless gnus-mime-button-map ! (setq gnus-mime-button-map (make-sparse-keymap)) ! (set-keymap-parent gnus-mime-button-map gnus-article-mode-map) (define-key gnus-mime-button-map gnus-mouse-2 'gnus-article-push-button) ! (define-key gnus-mime-button-map gnus-mouse-3 'gnus-mime-button-menu) ! (mapcar (lambda (c) ! (define-key gnus-mime-button-map (cadr c) (car c))) ! gnus-mime-button-commands)) ! ! (defun gnus-mime-button-menu (event) ! "Construct a context-sensitive menu of MIME commands." ! (interactive "e") ! ) (defun gnus-mime-view-all-parts () "View all the MIME parts." *************** *** 2206,2214 **** (defun gnus-mime-copy-part () "Put the the MIME part under point into a new buffer." (interactive) ! (let* ((data (get-text-property (point) 'gnus-data)) ! (contents (mm-get-part data))) ! (switch-to-buffer (generate-new-buffer "*decoded*")) (insert contents) (goto-char (point-min)))) --- 2261,2277 ---- (defun gnus-mime-copy-part () "Put the the MIME part under point into a new buffer." (interactive) ! (let* ((handle (get-text-property (point) 'gnus-data)) ! (contents (mm-get-part handle)) ! (buffer (generate-new-buffer ! (file-name-nondirectory ! (or ! (mail-content-type-get (mm-handle-type handle) 'name) ! (mail-content-type-get (mm-handle-type handle) ! 'filename) ! "*decoded*"))))) ! (set-buffer-major-mode buffer) ! (switch-to-buffer buffer) (insert contents) (goto-char (point-min)))) *************** *** 2235,2256 **** (error "No such part")) (let ((handle (cdr (assq n gnus-article-mime-handle-alist)))) (gnus-article-goto-part n) ! (mm-display-part handle)))) (defun gnus-article-goto-part (n) "Go to MIME part N." (goto-char (text-property-any (point-min) (point-max) 'gnus-part n))) ! (defun gnus-insert-mime-button (handle) (let ((gnus-tmp-name (mail-content-type-get (mm-handle-type handle) 'name)) (gnus-tmp-type (car (mm-handle-type handle))) (gnus-tmp-description (mm-handle-description handle)) (gnus-tmp-length (save-excursion (set-buffer (mm-handle-buffer handle)) (buffer-size))) - (gnus-tmp-id (1+ (length gnus-article-mime-handle-alist))) b e) - (push (cons gnus-tmp-id handle) gnus-article-mime-handle-alist) (setq gnus-tmp-name (if gnus-tmp-name (concat " (" gnus-tmp-name ")") --- 2298,2331 ---- (error "No such part")) (let ((handle (cdr (assq n gnus-article-mime-handle-alist)))) (gnus-article-goto-part n) ! (gnus-set-window-start) ! (gnus-mm-display-part handle)))) ! ! (defun gnus-mm-display-part (handle) ! "Display HANDLE and fix MIME button." ! (let ((id (get-text-property (point) 'gnus-part)) ! buffer-read-only) ! (delete-region (gnus-point-at-bol) (progn (forward-line 1) (point))) ! (gnus-insert-mime-button ! handle id (list (not (mm-handle-displayed-p handle))))) ! (mm-display-part handle)) (defun gnus-article-goto-part (n) "Go to MIME part N." (goto-char (text-property-any (point-min) (point-max) 'gnus-part n))) ! (defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed) (let ((gnus-tmp-name (mail-content-type-get (mm-handle-type handle) 'name)) (gnus-tmp-type (car (mm-handle-type handle))) (gnus-tmp-description (mm-handle-description handle)) + (gnus-tmp-dots + (if (if displayed (car displayed) + (mm-handle-displayed-p handle)) + "" "...")) (gnus-tmp-length (save-excursion (set-buffer (mm-handle-buffer handle)) (buffer-size))) b e) (setq gnus-tmp-name (if gnus-tmp-name (concat " (" gnus-tmp-name ")") *************** *** 2264,2276 **** gnus-mime-button-line-format gnus-mime-button-line-format-alist `(local-map ,gnus-mime-button-map keymap ,gnus-mime-button-map ! gnus-callback mm-display-part gnus-part ,gnus-tmp-id gnus-type annotation gnus-data ,handle)) (setq e (point)) (widget-convert-button 'link b e :action 'gnus-widget-press-button ! :button-keymap gnus-widget-button-keymap))) (defun gnus-widget-press-button (elems el) (goto-char (widget-get elems :from)) --- 2339,2351 ---- gnus-mime-button-line-format gnus-mime-button-line-format-alist `(local-map ,gnus-mime-button-map keymap ,gnus-mime-button-map ! gnus-callback gnus-mm-display-part gnus-part ,gnus-tmp-id gnus-type annotation gnus-data ,handle)) (setq e (point)) (widget-convert-button 'link b e :action 'gnus-widget-press-button ! :button-keymap gnus-mime-button-map))) (defun gnus-widget-press-button (elems el) (goto-char (widget-get elems :from)) *************** *** 2286,2292 **** (setq ctl (condition-case () (mail-header-parse-content-type ct) (error nil))))) (let* ((handles (mm-dissect-buffer)) ! handle name type b e) (mapcar 'mm-destroy-part gnus-article-mime-handles) (setq gnus-article-mime-handles handles gnus-article-mime-handle-alist nil) --- 2361,2367 ---- (setq ctl (condition-case () (mail-header-parse-content-type ct) (error nil))))) (let* ((handles (mm-dissect-buffer)) ! handle name type b e display) (mapcar 'mm-destroy-part gnus-article-mime-handles) (setq gnus-article-mime-handles handles gnus-article-mime-handle-alist nil) *************** *** 2296,2309 **** (delete-region (point) (point-max)) (if (not (equal (car ctl) "multipart/alternative")) (while (setq handle (pop handles)) ! (gnus-insert-mime-button handle) ! (insert "\n\n") (when (and (mm-automatic-display-p (car (mm-handle-type handle))) (mm-inlinable-part-p (car (mm-handle-type handle))) (or (not (mm-handle-disposition handle)) (equal (car (mm-handle-disposition handle)) "inline"))) (forward-line -2) (mm-display-part handle t) (goto-char (point-max)))) --- 2371,2389 ---- (delete-region (point) (point-max)) (if (not (equal (car ctl) "multipart/alternative")) (while (setq handle (pop handles)) ! (setq display nil) (when (and (mm-automatic-display-p (car (mm-handle-type handle))) (mm-inlinable-part-p (car (mm-handle-type handle))) (or (not (mm-handle-disposition handle)) (equal (car (mm-handle-disposition handle)) "inline"))) + (setq display t)) + (let ((id (1+ (length gnus-article-mime-handle-alist)))) + (push (cons id handle) gnus-article-mime-handle-alist) + (gnus-insert-mime-button handle id (list display))) + (insert "\n\n") + (when display (forward-line -2) (mm-display-part handle t) (goto-char (point-max)))) *************** *** 2786,2793 **** (defvar gnus-article-edit-mode-map nil) (unless gnus-article-edit-mode-map ! (setq gnus-article-edit-mode-map (copy-keymap text-mode-map)) (gnus-define-keys gnus-article-edit-mode-map "\C-c\C-c" gnus-article-edit-done --- 2866,2875 ---- (defvar gnus-article-edit-mode-map nil) + ;; Should we be using derived.el for this? (unless gnus-article-edit-mode-map ! (setq gnus-article-edit-mode-map (make-sparse-keymap)) ! (set-keymap-parent gnus-article-edit-mode-map text-mode-map) (gnus-define-keys gnus-article-edit-mode-map "\C-c\C-c" gnus-article-edit-done *************** *** 2873,2879 **** (save-excursion (set-buffer buf) (let ((buffer-read-only nil)) ! (funcall func arg))) (set-buffer buf) (set-window-start (get-buffer-window buf) start) (set-window-point (get-buffer-window buf) (point)))) --- 2955,2973 ---- (save-excursion (set-buffer buf) (let ((buffer-read-only nil)) ! (funcall func arg)) ! ;; The cache and backlog have to be flushed somewhat. ! (when gnus-keep-backlog ! (gnus-backlog-remove-article ! (car gnus-article-current) (cdr gnus-article-current))) ! ;; Flush original article as well. ! (save-excursion ! (when (get-buffer gnus-original-article-buffer) ! (set-buffer gnus-original-article-buffer) ! (setq gnus-original-article nil))) ! (when gnus-use-cache ! (gnus-cache-update-article ! (car gnus-article-current) (cdr gnus-article-current)))) (set-buffer buf) (set-window-start (get-buffer-window buf) start) (set-window-point (get-buffer-window buf) (point)))) *************** *** 2890,2907 **** (insert buf) (let ((winconf gnus-prev-winconf)) (gnus-article-mode) - ;; The cache and backlog have to be flushed somewhat. - (when gnus-use-cache - (gnus-cache-update-article - (car gnus-article-current) (cdr gnus-article-current))) - (when gnus-keep-backlog - (gnus-backlog-remove-article - (car gnus-article-current) (cdr gnus-article-current))) - ;; Flush original article as well. - (save-excursion - (when (get-buffer gnus-original-article-buffer) - (set-buffer gnus-original-article-buffer) - (setq gnus-original-article nil))) (set-window-configuration winconf) ;; Tippy-toe some to make sure that point remains where it was. (save-current-buffer --- 2984,2989 ---- *** pub/pgnus/lisp/gnus-draft.el Sun Oct 11 02:32:02 1998 --- pgnus/lisp/gnus-draft.el Tue Oct 20 00:27:04 1998 *************** *** 135,141 **** (message-remove-header gnus-agent-meta-information-header))) ;; Then we send it. If we have no meta-information, we just send ;; it and let Message figure out how. ! (when (and (or (gnus-server-opened method) (gnus-open-server method)) (if type (let ((message-this-is-news (eq type 'news)) --- 135,142 ---- (message-remove-header gnus-agent-meta-information-header))) ;; Then we send it. If we have no meta-information, we just send ;; it and let Message figure out how. ! (when (and (or (null method) ! (gnus-server-opened method) (gnus-open-server method)) (if type (let ((message-this-is-news (eq type 'news)) *** pub/pgnus/lisp/gnus-eform.el Sat Aug 29 19:54:10 1998 --- pgnus/lisp/gnus-eform.el Tue Oct 20 00:27:04 1998 *************** *** 53,59 **** (defvar gnus-edit-form-mode-map nil) (unless gnus-edit-form-mode-map ! (setq gnus-edit-form-mode-map (copy-keymap emacs-lisp-mode-map)) (gnus-define-keys gnus-edit-form-mode-map "\C-c\C-c" gnus-edit-form-done "\C-c\C-k" gnus-edit-form-exit)) --- 53,60 ---- (defvar gnus-edit-form-mode-map nil) (unless gnus-edit-form-mode-map ! (setq gnus-edit-form-mode-map (make-sparse-keymap)) ! (set-keymap-parent gnus-edit-form-mode-map emacs-lisp-mode-map) (gnus-define-keys gnus-edit-form-mode-map "\C-c\C-c" gnus-edit-form-done "\C-c\C-k" gnus-edit-form-exit)) *** pub/pgnus/lisp/gnus-ems.el Thu Sep 24 02:33:03 1998 --- pgnus/lisp/gnus-ems.el Tue Oct 20 00:27:05 1998 *************** *** 33,38 **** --- 33,39 ---- "Non-nil if running under XEmacs.") (defvar gnus-mouse-2 [mouse-2]) + (defvar gnus-mouse-3 [mouse-3]) (defvar gnus-down-mouse-2 [down-mouse-2]) (defvar gnus-widget-button-keymap nil) (defvar gnus-mode-line-modified *** pub/pgnus/lisp/gnus-group.el Thu Sep 24 02:33:03 1998 --- pgnus/lisp/gnus-group.el Tue Oct 20 00:27:05 1998 *************** *** 3336,3361 **** (defun gnus-add-marked-articles (group type articles &optional info force) ;; Add ARTICLES of TYPE to the info of GROUP. ! ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't ;; add, but replace marked articles of TYPE with ARTICLES. (let ((info (or info (gnus-get-info group))) marked m) (or (not info) (and (not (setq marked (nthcdr 3 info))) (or (null articles) ! (setcdr (nthcdr 2 info) ! (list (list (cons type (gnus-compress-sequence ! articles t))))))) (and (not (setq m (assq type (car marked)))) (or (null articles) ! (setcar marked ! (cons (cons type (gnus-compress-sequence articles t) ) ! (car marked))))) (if force (if (null articles) ! (setcar (nthcdr 3 info) ! (gnus-delete-alist type (car marked))) ! (setcdr m (gnus-compress-sequence articles t))) (setcdr m (gnus-compress-sequence (sort (nconc (gnus-uncompress-range (cdr m)) (copy-sequence articles)) '<) t)))))) --- 3336,3361 ---- (defun gnus-add-marked-articles (group type articles &optional info force) ;; Add ARTICLES of TYPE to the info of GROUP. ! ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't ;; add, but replace marked articles of TYPE with ARTICLES. (let ((info (or info (gnus-get-info group))) marked m) (or (not info) (and (not (setq marked (nthcdr 3 info))) (or (null articles) ! (setcdr (nthcdr 2 info) ! (list (list (cons type (gnus-compress-sequence ! articles t))))))) (and (not (setq m (assq type (car marked)))) (or (null articles) ! (setcar marked ! (cons (cons type (gnus-compress-sequence articles t) ) ! (car marked))))) (if force (if (null articles) ! (setcar (nthcdr 3 info) ! (gnus-delete-alist type (car marked))) ! (setcdr m (gnus-compress-sequence articles t))) (setcdr m (gnus-compress-sequence (sort (nconc (gnus-uncompress-range (cdr m)) (copy-sequence articles)) '<) t)))))) *** pub/pgnus/lisp/gnus-int.el Thu Sep 24 02:33:03 1998 --- pgnus/lisp/gnus-int.el Tue Oct 20 00:27:05 1998 *************** *** 308,313 **** --- 308,323 ---- (funcall (gnus-get-function gnus-command-method 'request-type) (gnus-group-real-name group) article)))) + (defun gnus-request-set-mark (group action) + "Set marks on articles in the backend." + (let ((gnus-command-method (gnus-find-method-for-group group))) + (if (not (gnus-check-backend-function + 'request-set-mark (car gnus-command-method))) + action + (funcall (gnus-get-function gnus-command-method 'request-set-mark) + (gnus-group-real-name group) action + (nth 1 gnus-command-method))))) + (defun gnus-request-update-mark (group article mark) "Allow the backend to change the mark the user tries to put on an article." (let ((gnus-command-method (gnus-find-method-for-group group))) *** pub/pgnus/lisp/gnus-msg.el Sun Oct 11 02:32:03 1998 --- pgnus/lisp/gnus-msg.el Tue Oct 20 00:27:05 1998 *************** *** 620,625 **** --- 620,626 ---- (set-buffer gnus-original-article-buffer) (setq text (buffer-string))) (set-buffer (gnus-get-buffer-create " *Gnus forward*")) + (erase-buffer) (insert text) (run-hooks 'gnus-article-decode-hook) (let ((message-included-forward-headers *** pub/pgnus/lisp/gnus-range.el Sat Aug 29 19:53:57 1998 --- pgnus/lisp/gnus-range.el Tue Oct 20 00:27:05 1998 *************** *** 229,235 **** Note: LIST has to be sorted over `<'." ;; !!! This function shouldn't look like this, but I've got a headache. (gnus-compress-sequence ! (gnus-sorted-complement (gnus-uncompress-range ranges) list))) (defun gnus-member-of-range (number ranges) --- 229,235 ---- Note: LIST has to be sorted over `<'." ;; !!! This function shouldn't look like this, but I've got a headache. (gnus-compress-sequence ! (gnus-set-difference (gnus-uncompress-range ranges) list))) (defun gnus-member-of-range (number ranges) *** pub/pgnus/lisp/gnus-sum.el Sun Oct 11 02:32:04 1998 --- pgnus/lisp/gnus-sum.el Tue Oct 20 00:27:06 1998 *************** *** 34,39 **** --- 34,40 ---- (require 'gnus-int) (require 'gnus-undo) (require 'gnus-util) + (require 'mm-decode) (autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t) (defcustom gnus-kill-summary-on-exit t *************** *** 1516,1522 **** ["Words" gnus-article-decode-mime-words t] ["Charset" gnus-article-decode-charset t] ["QP" gnus-article-de-quoted-unreadable t] ! ["View all" gnus-mime-view-all-parts]) ("Date" ["Local" gnus-article-date-local t] ["ISO8601" gnus-article-date-iso8601 t] --- 1517,1523 ---- ["Words" gnus-article-decode-mime-words t] ["Charset" gnus-article-decode-charset t] ["QP" gnus-article-de-quoted-unreadable t] ! ["View all" gnus-mime-view-all-parts t]) ("Date" ["Local" gnus-article-date-local t] ["ISO8601" gnus-article-date-iso8601 t] *************** *** 4139,4145 **** (let ((types gnus-article-mark-lists) (info (gnus-get-info gnus-newsgroup-name)) (uncompressed '(score bookmark killed)) ! type list newmarked symbol) (when info ;; Add all marks lists that are non-nil to the list of marks lists. (while (setq type (pop types)) --- 4140,4146 ---- (let ((types gnus-article-mark-lists) (info (gnus-get-info gnus-newsgroup-name)) (uncompressed '(score bookmark killed)) ! type list newmarked symbol delta-marks) (when info ;; Add all marks lists that are non-nil to the list of marks lists. (while (setq type (pop types)) *************** *** 5168,5174 **** gnus-expert-user (gnus-y-or-n-p "Discard changes to this group and exit? ")) (gnus-async-halt-prefetch) ! (gnus-run-hooks 'gnus-summary-prepare-exit-hook) (when (gnus-buffer-live-p gnus-article-buffer) (save-excursion (set-buffer gnus-article-buffer) --- 5169,5176 ---- gnus-expert-user (gnus-y-or-n-p "Discard changes to this group and exit? ")) (gnus-async-halt-prefetch) ! (gnus-run-hooks (delq 'gnus-summary-expire-articles ! (copy-list gnus-summary-prepare-exit-hook))) (when (gnus-buffer-live-p gnus-article-buffer) (save-excursion (set-buffer gnus-article-buffer) *************** *** 8956,8963 **** (setq unread (cdr unread))) (when (<= prev (cdr active)) (push (cons prev (cdr active)) read)) (if compute ! (if (> (length read) 1) (nreverse read) read) (save-excursion (set-buffer gnus-group-buffer) (gnus-undo-register --- 8958,8966 ---- (setq unread (cdr unread))) (when (<= prev (cdr active)) (push (cons prev (cdr active)) read)) + (setq read (if (> (length read) 1) (nreverse read) read)) (if compute ! read (save-excursion (set-buffer gnus-group-buffer) (gnus-undo-register *************** *** 8967,8974 **** (gnus-get-unread-articles-in-group ',info (gnus-active ,group)) (gnus-group-update-group ,group t)))) ;; Enter this list into the group info. ! (gnus-info-set-read ! info (if (> (length read) 1) (nreverse read) read)) ;; Set the number of unread articles in gnus-newsrc-hashtb. (gnus-get-unread-articles-in-group info (gnus-active group)) t)))) --- 8970,8976 ---- (gnus-get-unread-articles-in-group ',info (gnus-active ,group)) (gnus-group-update-group ,group t)))) ;; Enter this list into the group info. ! (gnus-info-set-read info read) ;; Set the number of unread articles in gnus-newsrc-hashtb. (gnus-get-unread-articles-in-group info (gnus-active group)) t)))) *** pub/pgnus/lisp/gnus-util.el Thu Sep 24 02:33:06 1998 --- pgnus/lisp/gnus-util.el Tue Oct 20 00:27:07 1998 *************** *** 908,913 **** --- 908,919 ---- re (unless (string-match "\\$$" re) ".*$"))) + (defun gnus-set-window-start (&optional point) + "Set the window start to POINT, or (point) if nil." + (let ((win (get-buffer-window (current-buffer) t))) + (when win + (set-window-start win (or point (point)))))) + (provide 'gnus-util) ;;; gnus-util.el ends here *** pub/pgnus/lisp/gnus-uu.el Sun Oct 11 02:32:04 1998 --- pgnus/lisp/gnus-uu.el Tue Oct 20 00:27:07 1998 *************** *** 1796,1802 **** (gnus-summary-post-news) ! (use-local-map (copy-keymap (current-local-map))) (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done) (local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews) (local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews) --- 1796,1804 ---- (gnus-summary-post-news) ! (let ((map (make-sparse-keymap))) ! (set-keymap-parent map (current-local-map)) ! (use-local-map map)) (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done) (local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews) (local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews) *** pub/pgnus/lisp/gnus-xmas.el Sun Oct 11 02:32:04 1998 --- pgnus/lisp/gnus-xmas.el Tue Oct 20 00:27:07 1998 *************** *** 386,391 **** --- 386,392 ---- (defun gnus-xmas-define () (setq gnus-mouse-2 [button2]) + (setq gnus-mouse-3 [button3]) (setq gnus-widget-button-keymap widget-button-keymap) (unless (memq 'underline (face-list)) *************** *** 463,469 **** (fset 'gnus-key-press-event-p 'key-press-event-p) (fset 'gnus-region-active-p 'region-active-p) (fset 'gnus-annotation-in-region-p 'gnus-xmas-annotation-in-region-p) ! (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add) (add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add) (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add) --- 464,471 ---- (fset 'gnus-key-press-event-p 'key-press-event-p) (fset 'gnus-region-active-p 'region-active-p) (fset 'gnus-annotation-in-region-p 'gnus-xmas-annotation-in-region-p) ! (fset 'gnus-mime-button-menu 'gnus-xmas-mime-button-menu) ! (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add) (add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add) (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add) *************** *** 791,796 **** --- 793,810 ---- (defun gnus-xmas-annotation-in-region-p (b e) (map-extents (lambda (e u) t) nil b e nil nil 'mm t)) + + (defun gnus-xmas-mime-button-menu (event) + "Construct a context-sensitive menu of MIME commands." + (interactive "e") + (let ((response (get-popup-menu-response + `("MIME Part" + ,@(mapcar (lambda (c) `[,(caddr c) ,(car c) t]) + gnus-mime-button-commands))))) + (set-buffer (event-buffer event)) + (goto-char (event-point event)) + (funcall (event-function response) (event-object response)))) + (provide 'gnus-xmas) *** pub/pgnus/lisp/gnus.el Sun Oct 11 02:32:05 1998 --- pgnus/lisp/gnus.el Tue Oct 20 00:27:07 1998 *************** *** 250,256 **** :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) ! (defconst gnus-version-number "0.34" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) --- 250,256 ---- :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) ! (defconst gnus-version-number "0.35" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) *** pub/pgnus/lisp/lpath.el Thu Sep 24 02:33:07 1998 --- pgnus/lisp/lpath.el Tue Oct 20 00:27:07 1998 *************** *** 34,40 **** set-buffer-multibyte find-non-ascii-charset-region char-charset mule-write-region-no-coding-system ! find-charset-region base64-decode-string find-coding-systems-region get-charset-property coding-system-get w3-region rmail-summary-exists rmail-select-summary --- 34,40 ---- set-buffer-multibyte find-non-ascii-charset-region char-charset mule-write-region-no-coding-system ! find-charset-region find-coding-systems-region get-charset-property coding-system-get w3-region rmail-summary-exists rmail-select-summary *************** *** 69,75 **** mm-copy-tree url-view-url w3-prepare-buffer mule-write-region-no-coding-system char-int annotationp delete-annotation make-image-specifier ! make-annotation base64-decode-string base64-encode-region w3-do-setup w3-region rmail-summary-exists rmail-select-summary rmail-update-summary ))) --- 69,75 ---- mm-copy-tree url-view-url w3-prepare-buffer mule-write-region-no-coding-system char-int annotationp delete-annotation make-image-specifier ! make-annotation w3-do-setup w3-region rmail-summary-exists rmail-select-summary rmail-update-summary ))) *** pub/pgnus/lisp/mailcap.el Sun Oct 11 02:32:05 1998 --- pgnus/lisp/mailcap.el Tue Oct 20 00:27:08 1998 *************** *** 117,123 **** (viewer . "maplay %s") (type . "audio/x-mpeg")) (".*" ! (viewer . mm-view-sound-file) (test . (or (featurep 'nas-sound) (featurep 'native-sound))) (type . "audio/*")) --- 117,123 ---- (viewer . "maplay %s") (type . "audio/x-mpeg")) (".*" ! (viewer . mailcap-save-binary-file) (test . (or (featurep 'nas-sound) (featurep 'native-sound))) (type . "audio/*")) *************** *** 322,328 **** fname) (while fnames (setq fname (car fnames)) ! (if (and (file-exists-p fname) (file-readable-p fname)) (mailcap-parse-mailcap (car fnames))) (setq fnames (cdr fnames)))) (setq mailcap-parsed-p t))) --- 322,329 ---- fname) (while fnames (setq fname (car fnames)) ! (if (and (file-exists-p fname) (file-readable-p fname) ! (file-regular-p fname)) (mailcap-parse-mailcap (car fnames))) (setq fnames (cdr fnames)))) (setq mailcap-parsed-p t))) *************** *** 632,638 **** (if (mailcap-viewer-passes-test (car viewers) info) (setq passed (cons (car viewers) passed))) (setq viewers (cdr viewers))) ! (setq passed (sort passed 'mailcap-viewer-lessp)) (setq viewer (car passed)))) (when (and (stringp (cdr (assq 'viewer viewer))) passed) --- 633,639 ---- (if (mailcap-viewer-passes-test (car viewers) info) (setq passed (cons (car viewers) passed))) (setq viewers (cdr viewers))) ! (setq passed (sort (nreverse passed) 'mailcap-viewer-lessp)) (setq viewer (car passed)))) (when (and (stringp (cdr (assq 'viewer viewer))) passed) *** pub/pgnus/lisp/message.el Sun Oct 11 02:32:05 1998 --- pgnus/lisp/message.el Tue Oct 20 00:27:08 1998 *************** *** 212,218 **** :group 'message-headers :type 'regexp) ! (defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^X-Trace:\\|^X-Complaints-To:" "*Header lines matching this regexp will be deleted before posting. It's best to delete old Path and Date headers before posting to avoid any confusion." --- 212,218 ---- :group 'message-headers :type 'regexp) ! (defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:" "*Header lines matching this regexp will be deleted before posting. It's best to delete old Path and Date headers before posting to avoid any confusion." *************** *** 646,655 **** The default is `abbrev', which uses mailabbrev. nil switches mail aliases off.") ! (defcustom message-autosave-directory (nnheader-concat message-directory "drafts/") ! "*Directory where Message autosaves buffers if Gnus isn't running. ! If nil, Message won't autosave." :group 'message-buffers :type 'directory) --- 646,655 ---- The default is `abbrev', which uses mailabbrev. nil switches mail aliases off.") ! (defcustom message-auto-save-directory (nnheader-concat message-directory "drafts/") ! "*Directory where Message auto-saves buffers if Gnus isn't running. ! If nil, Message won't auto-save." :group 'message-buffers :type 'directory) *************** *** 1227,1233 **** (defvar message-mode-map nil) (unless message-mode-map ! (setq message-mode-map (copy-keymap text-mode-map)) (define-key message-mode-map "\C-c?" 'describe-mode) (define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to) --- 1227,1234 ---- (defvar message-mode-map nil) (unless message-mode-map ! (setq message-mode-map (make-keymap)) ! (set-keymap-parent message-mode-map text-mode-map) (define-key message-mode-map "\C-c?" 'describe-mode) (define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to) *************** *** 1327,1332 **** --- 1328,1334 ---- C-c C-y message-yank-original (insert current message, if any). C-c C-q message-fill-yanked-message (fill what was yanked). C-c C-e message-elide-region (elide the text between point and mark). + C-c C-v message-delete-not-region (remove the text outside the region). C-c C-z message-kill-to-signature (kill the text up to the signature). C-c C-r message-caesar-buffer-body (rot13 the message body)." (interactive) *************** *** 1503,1509 **** (let ((co (message-fetch-reply-field "mail-copies-to"))) (when (and (null force) co ! (equal (downcase co) "never")) (error "The user has requested not to have copies sent via mail"))) (when (and (message-position-on-field "To") (mail-fetch-field "to") --- 1505,1512 ---- (let ((co (message-fetch-reply-field "mail-copies-to"))) (when (and (null force) co ! (or (equal (downcase co) "never") ! (equal (downcase co) "nobody"))) (error "The user has requested not to have copies sent via mail"))) (when (and (message-position-on-field "To") (mail-fetch-field "to") *************** *** 1945,1990 **** Otherwise any failure is reported in a message back to the user from the mailer." (interactive "P") ! ;; Disabled test. ! (when (or (buffer-modified-p) ! (message-check-element 'unchanged) ! (y-or-n-p "No changes in the buffer; really send? ")) ! ;; Make it possible to undo the coming changes. ! (undo-boundary) ! (let ((inhibit-read-only t)) ! (put-text-property (point-min) (point-max) 'read-only nil)) ! (message-fix-before-sending) ! (run-hooks 'message-send-hook) ! (message "Sending...") ! (let ((alist message-send-method-alist) ! (success t) ! elem sent) ! (while (and success ! (setq elem (pop alist))) ! (when (and (or (not (funcall (cadr elem))) ! (and (or (not (memq (car elem) ! message-sent-message-via)) ! (y-or-n-p ! (format ! "Already sent message via %s; resend? " ! (car elem)))) ! (setq success (funcall (caddr elem) arg))))) ! (setq sent t))) ! (when (and success sent) ! (message-do-fcc) ! ;;(when (fboundp 'mail-hist-put-headers-into-history) ! ;; (mail-hist-put-headers-into-history)) ! (run-hooks 'message-sent-hook) ! (message "Sending...done") ! ;; Mark the buffer as unmodified and delete autosave. ! (set-buffer-modified-p nil) ! (delete-auto-save-file-if-necessary t) ! (message-disassociate-draft) ! ;; Delete other mail buffers and stuff. ! (message-do-send-housekeeping) ! (message-do-actions message-send-actions) ! ;; Return success. ! t)))) (defun message-send-via-mail (arg) "Send the current message via mail." --- 1948,1989 ---- Otherwise any failure is reported in a message back to the user from the mailer." (interactive "P") ! ;; Make it possible to undo the coming changes. ! (undo-boundary) ! (let ((inhibit-read-only t)) ! (put-text-property (point-min) (point-max) 'read-only nil)) ! (message-fix-before-sending) ! (run-hooks 'message-send-hook) ! (message "Sending...") ! (let ((alist message-send-method-alist) ! (success t) ! elem sent) ! (while (and success ! (setq elem (pop alist))) ! (when (and (or (not (funcall (cadr elem))) ! (and (or (not (memq (car elem) ! message-sent-message-via)) ! (y-or-n-p ! (format ! "Already sent message via %s; resend? " ! (car elem)))) ! (setq success (funcall (caddr elem) arg))))) ! (setq sent t))) ! (when (and success sent) ! (message-do-fcc) ! ;;(when (fboundp 'mail-hist-put-headers-into-history) ! ;; (mail-hist-put-headers-into-history)) ! (run-hooks 'message-sent-hook) ! (message "Sending...done") ! ;; Mark the buffer as unmodified and delete auto-save. ! (set-buffer-modified-p nil) ! (delete-auto-save-file-if-necessary t) ! (message-disassociate-draft) ! ;; Delete other mail buffers and stuff. ! (message-do-send-housekeeping) ! (message-do-actions message-send-actions) ! ;; Return success. ! t))) (defun message-send-via-mail (arg) "Send the current message via mail." *************** *** 1994,1999 **** --- 1993,2007 ---- "Send the current message via news." (funcall message-send-news-function arg)) + (defmacro message-check (type &rest forms) + "Eval FORMS if TYPE is to be checked." + `(or (message-check-element ,type) + (save-excursion + ,@forms))) + + (put 'message-check 'lisp-indent-function 1) + (put 'message-check 'edebug-form-spec '(form body)) + (defun message-fix-before-sending () "Do various things to make the message nice before sending it." ;; Make sure there's a newline at the end of the message. *************** *** 2266,2280 **** ;;; Header generation & syntax checking. ;;; - (defmacro message-check (type &rest forms) - "Eval FORMS if TYPE is to be checked." - `(or (message-check-element ,type) - (save-excursion - ,@forms))) - - (put 'message-check 'lisp-indent-function 1) - (put 'message-check 'edebug-form-spec '(form body)) - (defun message-check-element (type) "Returns non-nil if this type is not to be checked." (if (eq message-syntax-checks 'dont-check-for-anything-just-trust-me) --- 2274,2279 ---- *************** *** 2638,2649 **** (sign "+")) (when (< zone 0) (setq sign "")) ! ;; We do all of this because XEmacs doesn't have the %z spec. ! (concat (format-time-string ! "%d %b %Y %H:%M:%S " (or now (current-time))) ! (format "%s%02d%02d" ! sign (/ zone 3600) ! (% zone 3600))))) (defun message-make-message-id () "Make a unique Message-ID." --- 2637,2651 ---- (sign "+")) (when (< zone 0) (setq sign "")) ! (concat ! (format-time-string "%d" now) ! ;; The month name of the %b spec is locale-specific. Pfff. ! (format " %s " ! (capitalize (car (rassoc (nth 4 (decode-time now)) ! parse-time-months)))) ! (format-time-string "%Y %H:%M:%S " now) ! ;; We do all of this because XEmacs doesn't have the %z spec. ! (format "%s%02d%02d" sign (/ zone 3600) (% zone 3600))))) (defun message-make-message-id () "Make a unique Message-ID." *************** *** 3254,3265 **** (defun message-set-auto-save-file-name () "Associate the message buffer with a file in the drafts directory." ! (when message-autosave-directory (if (gnus-alive-p) (setq message-draft-article (nndraft-request-associate-buffer "drafts")) (setq buffer-file-name (expand-file-name "*message*" ! message-autosave-directory)) (setq buffer-auto-save-file-name (make-auto-save-file-name))) (clear-visited-file-modtime))) --- 3256,3267 ---- (defun message-set-auto-save-file-name () "Associate the message buffer with a file in the drafts directory." ! (when message-auto-save-directory (if (gnus-alive-p) (setq message-draft-article (nndraft-request-associate-buffer "drafts")) (setq buffer-file-name (expand-file-name "*message*" ! message-auto-save-directory)) (setq buffer-auto-save-file-name (make-auto-save-file-name))) (clear-visited-file-modtime))) *************** *** 3341,3350 **** ;; Handle special values of Mail-Copies-To. (when mct ! (cond ((equal (downcase mct) "never") (setq never-mct t) (setq mct nil)) ! ((equal (downcase mct) "always") (setq mct (or reply-to from))))) (unless follow-to --- 3343,3354 ---- ;; Handle special values of Mail-Copies-To. (when mct ! (cond ((or (equal (downcase mct) "never") ! (equal (downcase mct) "nobody")) (setq never-mct t) (setq mct nil)) ! ((or (equal (downcase mct) "always") ! (equal (downcase mct) "poster")) (setq mct (or reply-to from))))) (unless follow-to *************** *** 3511,3518 **** `((References . ,(concat (or references "") (and references " ") (or message-id ""))))) ,@(when (and mct ! (not (equal (downcase mct) "never"))) ! (list (cons 'Cc (if (equal (downcase mct) "always") (or reply-to from "") mct))))) --- 3515,3524 ---- `((References . ,(concat (or references "") (and references " ") (or message-id ""))))) ,@(when (and mct ! (not (or (equal (downcase mct) "never") ! (equal (downcase mct) "nobody")))) ! (list (cons 'Cc (if (or (equal (downcase mct) "always") ! (equal (downcase mct) "poster")) (or reply-to from "") mct))))) *** pub/pgnus/lisp/mm-bodies.el Sun Oct 11 02:32:05 1998 --- pgnus/lisp/mm-bodies.el Tue Oct 20 00:27:08 1998 *************** *** 26,32 **** (eval-and-compile (or (fboundp 'base64-decode-region) ! (autoload 'base64-decode-region "base64" nil t))) (require 'mm-util) (require 'rfc2047) (require 'qp) --- 26,33 ---- (eval-and-compile (or (fboundp 'base64-decode-region) ! (require 'base64))) ! (require 'mm-util) (require 'rfc2047) (require 'qp) *************** *** 113,124 **** ) ((eq encoding 'x-uuencode) (condition-case () ! (uu-decode-region (point-min) (point-max)) (error nil))) (t (error "Can't decode encoding %s" encoding)))) ! (defun mm-decode-body (charset encoding) "Decode the current article that has been encoded with ENCODING. The characters in CHARSET should then be decoded." (setq charset (or charset rfc2047-default-charset)) --- 114,125 ---- ) ((eq encoding 'x-uuencode) (condition-case () ! (uudecode-decode-region (point-min) (point-max)) (error nil))) (t (error "Can't decode encoding %s" encoding)))) ! (defun mm-decode-body (charset &optional encoding) "Decode the current article that has been encoded with ENCODING. The characters in CHARSET should then be decoded." (setq charset (or charset rfc2047-default-charset)) *** pub/pgnus/lisp/mm-decode.el Sun Oct 11 02:32:06 1998 --- pgnus/lisp/mm-decode.el Tue Oct 20 00:27:08 1998 *************** *** 28,33 **** --- 28,50 ---- (require 'mailcap) (require 'mm-bodies) + ;;; Convenience macros. + + (defmacro mm-handle-buffer (handle) + `(nth 0 ,handle)) + (defmacro mm-handle-type (handle) + `(nth 1 ,handle)) + (defmacro mm-handle-encoding (handle) + `(nth 2 ,handle)) + (defmacro mm-handle-undisplayer (handle) + `(nth 3 ,handle)) + (defmacro mm-handle-set-undisplayer (handle function) + `(setcar (nthcdr 3 ,handle) ,function)) + (defmacro mm-handle-disposition (handle) + `(nth 4 ,handle)) + (defmacro mm-handle-description (handle) + `(nth 5 ,handle)) + (defvar mm-inline-media-tests '(("image/jpeg" mm-inline-image (featurep 'jpeg)) ("image/png" mm-inline-image (featurep 'png)) *************** *** 51,60 **** (defvar mm-user-display-methods '(("image/.*" . inline) ! ("text/.*" . inline))) (defvar mm-user-automatic-display ! '("text/plain" "text/enriched" "text/richtext" "text/html" "image/gif")) (defvar mm-alternative-precedence '("text/plain" "text/enriched" "text/richtext" "text/html") --- 68,79 ---- (defvar mm-user-display-methods '(("image/.*" . inline) ! ("text/.*" . inline) ! ("message/delivery-status" . inline))) (defvar mm-user-automatic-display ! '("text/plain" "text/enriched" "text/richtext" "text/html" "image/gif" ! "message/delivery-status")) (defvar mm-alternative-precedence '("text/plain" "text/enriched" "text/richtext" "text/html") *************** *** 69,91 **** (defvar mm-last-shell-command "") (defvar mm-content-id-alist nil) - ;;; Convenience macros. - - (defmacro mm-handle-buffer (handle) - `(nth 0 ,handle)) - (defmacro mm-handle-type (handle) - `(nth 1 ,handle)) - (defmacro mm-handle-encoding (handle) - `(nth 2 ,handle)) - (defmacro mm-handle-undisplayer (handle) - `(nth 3 ,handle)) - (defmacro mm-handle-set-undisplayer (handle function) - `(setcar (nthcdr 3 ,handle) ,function)) - (defmacro mm-handle-disposition (handle) - `(nth 4 ,handle)) - (defmacro mm-handle-description (handle) - `(nth 5 ,handle)) - ;;; The functions. (defun mm-dissect-buffer (&optional no-strict-mime) --- 88,93 ---- *************** *** 186,192 **** "Display the MIME part represented by HANDLE." (save-excursion (mailcap-parse-mailcaps) ! (if (mm-handle-undisplayer handle) (mm-remove-part handle) (let* ((type (car (mm-handle-type handle))) (method (mailcap-mime-info type)) --- 188,194 ---- "Display the MIME part represented by HANDLE." (save-excursion (mailcap-parse-mailcaps) ! (if (mm-handle-displayed-p handle) (mm-remove-part handle) (let* ((type (car (mm-handle-type handle))) (method (mailcap-mime-info type)) *************** *** 209,215 **** (mm-handle-encoding handle) (car (mm-handle-type handle))) (if (functionp method) (let ((cur (current-buffer))) ! (switch-to-buffer (generate-new-buffer "*mm*")) (buffer-disable-undo) (mm-set-buffer-file-coding-system 'no-conversion) (insert-buffer-substring cur) --- 211,220 ---- (mm-handle-encoding handle) (car (mm-handle-type handle))) (if (functionp method) (let ((cur (current-buffer))) ! (if (eq method 'mailcap-save-binary-file) ! (set-buffer (generate-new-buffer "*mm*")) ! (select-window (get-buffer-window cur t)) ! (switch-to-buffer (generate-new-buffer "*mm*"))) (buffer-disable-undo) (mm-set-buffer-file-coding-system 'no-conversion) (insert-buffer-substring cur) *************** *** 277,283 **** (defun mm-display-inline (handle) (let* ((type (car (mm-handle-type handle))) (function (cadr (assoc type mm-inline-media-tests)))) ! (funcall function handle))) (defun mm-inlinable-p (type) "Say whether TYPE can be displayed inline." --- 282,289 ---- (defun mm-display-inline (handle) (let* ((type (car (mm-handle-type handle))) (function (cadr (assoc type mm-inline-media-tests)))) ! (funcall function handle) ! (goto-char (point-min)))) (defun mm-inlinable-p (type) "Say whether TYPE can be displayed inline." *************** *** 324,329 **** --- 330,339 ---- (when (buffer-live-p (mm-handle-buffer handle)) (kill-buffer (mm-handle-buffer handle)))) + (defun mm-handle-displayed-p (handle) + "Say whether HANDLE is displayed or not." + (mm-handle-undisplayer handle)) + (defun mm-quote-arg (arg) "Return a version of ARG that is safe to evaluate in a shell." (let ((pos 0) new-pos accum) *** pub/pgnus/lisp/mm-util.el Sun Oct 11 02:32:06 1998 --- pgnus/lisp/mm-util.el Tue Oct 20 00:27:08 1998 *************** *** 171,176 **** --- 171,181 ---- (when (fboundp 'set-buffer-multibyte) (set-buffer-multibyte t))) + (defsubst mm-disable-multibyte () + "Disable multibyte in the current buffer." + (when (fboundp 'set-buffer-multibyte) + (set-buffer-multibyte nil))) + (defun mm-mime-charset (charset b e) (if (fboundp 'coding-system-get) (or *** pub/pgnus/lisp/mm-view.el Sun Oct 11 02:32:06 1998 --- pgnus/lisp/mm-view.el Tue Oct 20 00:27:08 1998 *************** *** 26,31 **** --- 26,32 ---- (require 'mail-parse) (require 'mailcap) (require 'mm-bodies) + (require 'mm-decode) ;;; ;;; Functions for displaying various formats inline *** pub/pgnus/lisp/nnagent.el Fri Sep 11 12:31:18 1998 --- pgnus/lisp/nnagent.el Tue Oct 20 00:27:08 1998 *************** *** 73,79 **** (ftp-error (setq err (format "%s" arg))))) (nnagent-close-server) (nnheader-report ! 'nnagent (or err "No such file or directory: %s" dir))) ((not (file-directory-p (file-truename dir))) (nnagent-close-server) (nnheader-report 'nnagent "Not a directory: %s" dir)) --- 73,80 ---- (ftp-error (setq err (format "%s" arg))))) (nnagent-close-server) (nnheader-report ! 'nnagent (or err ! (format "No such file or directory: %s" dir)))) ((not (file-directory-p (file-truename dir))) (nnagent-close-server) (nnheader-report 'nnagent "Not a directory: %s" dir)) *** pub/pgnus/lisp/nndoc.el Thu Sep 17 13:42:48 1998 --- pgnus/lisp/nndoc.el Tue Oct 20 00:27:09 1998 *************** *** 455,461 **** (when (and limit (re-search-forward (concat "\ ! ^Content-Type:[ \t]*multipart/[a-z]+;\\(.*;\\)*" "[ \t\n]*[ \t]boundary=\"?[^\"\n]*[^\" \t\n]") limit t)) t))) --- 455,461 ---- (when (and limit (re-search-forward (concat "\ ! ^Content-Type:[ \t]*multipart/[a-z]+ *;\\(.*;\\)*" "[ \t\n]*[ \t]boundary=\"?[^\"\n]*[^\" \t\n]") limit t)) t))) *** pub/pgnus/lisp/nnheader.el Thu Sep 24 02:33:08 1998 --- pgnus/lisp/nnheader.el Tue Oct 20 00:27:09 1998 *************** *** 446,452 **** nil (narrow-to-region (point-min) (1- (point))) (goto-char (point-min)) ! (while (looking-at "[A-Z][^ \t]+:.*\n\\([ \t].*\n\\)*\\|From .*\n") (goto-char (match-end 0))) (prog1 (eobp) --- 446,452 ---- nil (narrow-to-region (point-min) (1- (point))) (goto-char (point-min)) ! (while (looking-at "[a-zA-Z][^ \t]+:.*\n\\([ \t].*\n\\)*\\|From .*\n") (goto-char (match-end 0))) (prog1 (eobp) *** pub/pgnus/lisp/nnmail.el Sun Oct 11 02:32:06 1998 --- pgnus/lisp/nnmail.el Tue Oct 20 00:27:09 1998 *************** *** 241,246 **** --- 241,253 ---- :group 'nnmail-retrieve :type 'string) + (defcustom nnmail-movemail-args nil + "*Extra arguments to give to `nnmail-movemail-program' to move mail from the inbox. + The default is nil" + :group 'nnmail-files + :group 'nnmail-retrieve + :type 'string) + (defcustom nnmail-pop-password-required nil "*Non-nil if a password is required when reading mail using POP." :group 'nnmail-retrieve *************** *** 597,603 **** nnmail-movemail-program exec-directory) nil errors nil inbox tofile) (when nnmail-internal-password ! (list nnmail-internal-password))))))) (push inbox nnmail-moved-inboxes) (if (and (not (buffer-modified-p errors)) (zerop result)) --- 604,612 ---- nnmail-movemail-program exec-directory) nil errors nil inbox tofile) (when nnmail-internal-password ! (list nnmail-internal-password)) ! (when nnmail-movemail-args ! nnmail-movemail-args)))))) (push inbox nnmail-moved-inboxes) (if (and (not (buffer-modified-p errors)) (zerop result)) *** pub/pgnus/lisp/pop3.el Sat Aug 29 19:54:06 1998 --- pgnus/lisp/pop3.el Tue Oct 20 00:27:09 1998 *************** *** 111,124 **** Returns the process associated with the connection." (let ((process-buffer (get-buffer-create (format "trace of POP session to %s" mailhost))) ! (process)) (save-excursion (set-buffer process-buffer) ! (erase-buffer) ! (setq pop3-read-point (point-min)) ! ) (setq process (open-network-stream "POP" process-buffer mailhost port)) (let ((response (pop3-read-response process t))) (setq pop3-timestamp (substring response (or (string-match "<" response) 0) --- 111,126 ---- Returns the process associated with the connection." (let ((process-buffer (get-buffer-create (format "trace of POP session to %s" mailhost))) ! (process) ! (coding-system-for-read 'no-conversion) ! (coding-system-for-write 'no-conversion) ! ) (save-excursion (set-buffer process-buffer) ! (erase-buffer)) (setq process (open-network-stream "POP" process-buffer mailhost port)) + (setq pop3-read-point (point-min)) (let ((response (pop3-read-response process t))) (setq pop3-timestamp (substring response (or (string-match "<" response) 0) *** pub/pgnus/lisp/rfc1843.el Tue Oct 20 00:27:22 1998 --- pgnus/lisp/rfc1843.el Tue Oct 20 00:27:09 1998 *************** *** 0 **** --- 1,172 ---- + ;;; rfc1843.el --- HZ (rfc1843) decoding + ;; Copyright (c) 1998 by Shenghuo Zhu + + ;; Author: Shenghuo Zhu + ;; $Revision: 1.3 $ + ;; Keywords: news HZ + ;; Time-stamp: + + ;; This file is not part of GNU Emacs, but the same permissions + ;; apply. + + ;; 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: + + ;; Usage: + ;; (require 'rfc1843) + ;; (rfc1843-gnus-setup) + ;; + ;; Test: + ;; (rfc1843-decode-string "~{<:Ky2;S{#,NpJ)l6HK!#~}") + + ;;; Code: + + (require 'mm-util) + + (defvar rfc1843-word-regexp + "~\\({\\([\041-\167][\041-\176]\\| \\)+\\(~}\\|$\\)") + + (defvar rfc1843-word-regexp-strictly + "~\\({\\([\041-\167][\041-\176]\\)+\\(~}\\|$\\)") + + (defvar rfc1843-hzp-word-regexp + "~\\({\\([\041-\167][\041-\176]\\| \\)+\\|\ + [<>]\\([\041-\175][\041-\176]\\| \\)+\\)\\(~}\\|$\\)") + + (defvar rfc1843-hzp-word-regexp-strictly + "~\\({\\([\041-\167][\041-\176]\\)+\\|\ + [<>]\\([\041-\175][\041-\176]\\)+\\)\\(~}\\|$\\)") + + (defcustom rfc1843-decode-loosely nil + "Loosely check HZ encoding if non-nil. + When it is set non-nil, only buffers or strings with strictly + HZ-encoded are decoded." + :type 'boolean + :group 'gnus) + + (defcustom rfc1843-decode-hzp t + "HZ+ decoding support if non-nil. + HZ+ specification (also known as HZP) is to provide a standardized + 7-bit representation of mixed Big5, GB, and ASCII text for convenient + e-mail transmission, news posting, etc. + The document of HZ+ 0.78 specification can be found at + ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc" + :type 'boolean + :group 'gnus) + + (defcustom rfc1843-newsgroups-regexp "chinese\\|hz" + "Regexp of newsgroups in which might be HZ encoded." + :type 'string + :group 'gnus) + + (defun rfc1843-decode-region (from to) + "Decode HZ in the region between FROM and TO." + (interactive "r") + (let (str firstc) + (save-excursion + (goto-char from) + (if (or rfc1843-decode-loosely + (re-search-forward (if rfc1843-decode-hzp + rfc1843-hzp-word-regexp-strictly + rfc1843-word-regexp-strictly) to t)) + (save-restriction + (narrow-to-region from to) + (goto-char (point-min)) + (while (re-search-forward (if rfc1843-decode-hzp + rfc1843-hzp-word-regexp + rfc1843-word-regexp) (point-max) t) + (setq str (match-string 1)) + (setq firstc (aref str 0)) + (insert (mm-decode-coding-string + (rfc1843-decode + (prog1 + (substring str 1) + (delete-region (match-beginning 0) (match-end 0))) + firstc) + (if (eq firstc ?{) 'cn-gb-2312 'cn-big5)))) + (goto-char (point-min)) + (while (search-forward "~" (point-max) t) + (cond ((eq (following-char) ?\n) + (delete-char -1) + (delete-char 1)) + ((eq (following-char) ?~) + (delete-char 1))))))))) + + (defun rfc1843-decode-string (string) + "Decode HZ STRING and return the results." + (let ((m (mm-multibyte-p))) + (with-temp-buffer + (when m + (mm-enable-multibyte)) + (insert string) + (inline + (rfc1843-decode-region (point-min) (point-max))) + (buffer-string)))) + + (defun rfc1843-decode (word &optional firstc) + "Decode HZ WORD and return it" + (let ((i -1) (s (substring word 0)) v) + (if (or (not firstc) (eq firstc ?{)) + (while (< (incf i) (length s)) + (if (eq (setq v (aref s i)) ? ) nil + (aset s i (+ 128 v)))) + (while (< (incf i) (length s)) + (if (eq (setq v (aref s i)) ? ) nil + (setq v (+ (* 94 v) (aref s (1+ i)) -3135)) + (aset s i (+ (/ v 157) (if (eq firstc ?<) 201 161))) + (setq v (% v 157)) + (aset s (incf i) (+ v (if (< v 63) 64 98)))))) + s)) + + (defun rfc1843-decode-article-body () + "Decode HZ encoded text in the article body." + (if (string-match (concat "\\<\\(" rfc1843-newsgroups-regexp "\\)\\>") + gnus-newsgroup-name) + (save-excursion + (save-restriction + (message-narrow-to-head) + (goto-char (point-max)) + (widen) + (rfc1843-decode-region (point) (point-max)))))) + + (defvar rfc1843-old-gnus-decode-header-function nil) + (defvar gnus-decode-header-methods) + (defvar gnus-decode-encoded-word-methods) + + (defun rfc1843-gnus-setup () + "Setup HZ decoding for Gnus." + (require 'gnus-art) + (require 'gnus-sum) + (add-hook 'gnus-article-decode-hook 'rfc1843-decode-article-body t) + (setq gnus-decode-encoded-word-function + 'gnus-multi-decode-encoded-word-string + gnus-decode-header-function + 'gnus-multi-decode-header + gnus-decode-encoded-word-methods + (nconc gnus-decode-encoded-word-methods + (list + (cons (concat "\\<\\(" rfc1843-newsgroups-regexp "\\)\\>") + 'rfc1843-decode-string))) + gnus-decode-header-methods + (nconc gnus-decode-header-methods + (list + (cons (concat "\\<\\(" rfc1843-newsgroups-regexp "\\)\\>") + 'rfc1843-decode-region))))) + + (provide 'rfc1843) + + ;;; rfc1843.el ends here *** pub/pgnus/lisp/rfc2047.el Thu Sep 24 02:33:09 1998 --- pgnus/lisp/rfc2047.el Tue Oct 20 00:27:10 1998 *************** *** 27,34 **** (eval-and-compile (eval '(unless (fboundp 'base64-decode-string) ! (autoload 'base64-decode-string "base64") ! (autoload 'base64-encode-region "base64" nil t)))) (require 'qp) (require 'mm-util) (require 'ietf-drums) --- 27,34 ---- (eval-and-compile (eval '(unless (fboundp 'base64-decode-string) ! (require 'base64)))) ! (require 'qp) (require 'mm-util) (require 'ietf-drums) *** pub/pgnus/lisp/score-mode.el Sat Sep 12 13:27:50 1998 --- pgnus/lisp/score-mode.el Tue Oct 20 00:27:10 1998 *************** *** 39,45 **** (defvar gnus-score-mode-map nil) (unless gnus-score-mode-map ! (setq gnus-score-mode-map (copy-keymap emacs-lisp-mode-map)) (define-key gnus-score-mode-map "\C-c\C-c" 'gnus-score-edit-exit) (define-key gnus-score-mode-map "\C-c\C-d" 'gnus-score-edit-insert-date) (define-key gnus-score-mode-map "\C-c\C-p" 'gnus-score-pretty-print)) --- 39,46 ---- (defvar gnus-score-mode-map nil) (unless gnus-score-mode-map ! (setq gnus-score-mode-map (make-sparse-keymap)) ! (set-keymap-parent gnus-score-mode-map emacs-lisp-mode-map) (define-key gnus-score-mode-map "\C-c\C-c" 'gnus-score-edit-exit) (define-key gnus-score-mode-map "\C-c\C-d" 'gnus-score-edit-insert-date) (define-key gnus-score-mode-map "\C-c\C-p" 'gnus-score-pretty-print)) *** pub/pgnus/lisp/uudecode.el Sun Oct 11 02:32:07 1998 --- pgnus/lisp/uudecode.el Tue Oct 20 00:27:10 1998 *************** *** 2,28 **** ;; Copyright (c) 1998 by Shenghuo Zhu ;; Author: Shenghuo Zhu ! ;; $Revision: 1.1 $ ;; Keywords: uudecode ! ;; 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: ;; Lots of codes are stolen from mm-decode.el, gnus-uu.el and ;; base64.el --- 2,30 ---- ;; Copyright (c) 1998 by Shenghuo Zhu ;; Author: Shenghuo Zhu ! ;; $Revision: 1.3 $ ;; Keywords: uudecode ! ;; This file is not part of GNU Emacs, but the same permissions ! ;; apply. ! ;; 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: ! ;; Lots of codes are stolen from mm-decode.el, gnus-uu.el and ;; base64.el *************** *** 31,64 **** (if (not (fboundp 'char-int)) (fset 'char-int 'identity)) ! (defvar uu-decoder-program "uudecode" "*Non-nil value should be a string that names a uu decoder. The program should expect to read uu data on its standard input and write the converted data to its standard output.") ! (defvar uu-decoder-switches nil ! "*List of command line flags passed to the command named by uu-decoder-program.") ! (defvar uu-alphabet "\040-\140") ! (defvar uu-begin-string "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$") ! (defvar uu-end-string "^end[ \t]*$") ! (defvar uu-body-line (let ((i 61) (str "^M")) (while (> (setq i (1- i)) 0) (setq str (concat str "[^a-z]"))) (concat str ".?$"))) ! (defvar uu-temporary-file-directory "/tmp/") ! (defun uu-decode-region-external (start end &optional file-name) ! "Decode uuencoded files using an external program." (interactive "r\nP") (let ((cbuf (current-buffer)) tempfile firstline work-buffer status) (save-excursion (goto-char start) ! (when (re-search-forward uu-begin-string nil t) (forward-line 1) (setq firstline (point)) (cond ((null file-name)) --- 33,69 ---- (if (not (fboundp 'char-int)) (fset 'char-int 'identity)) ! (defvar uudecode-decoder-program "uudecode" "*Non-nil value should be a string that names a uu decoder. The program should expect to read uu data on its standard input and write the converted data to its standard output.") ! (defvar uudecode-decoder-switches nil ! "*List of command line flags passed to the command named by uudecode-decoder-program.") ! (defconst uudecode-alphabet "\040-\140") ! (defconst uudecode-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$") ! (defconst uudecode-end-line "^end[ \t]*$") ! (defconst uudecode-body-line (let ((i 61) (str "^M")) (while (> (setq i (1- i)) 0) (setq str (concat str "[^a-z]"))) (concat str ".?$"))) ! (defvar uudecode-temporary-file-directory "/tmp/") ! ;;;###autoload ! (defun uudecode-decode-region-external (start end &optional file-name) ! "uudecode region between START and END with external decoder. ! ! If FILE-NAME is non-nil, save the result to FILE-NAME." (interactive "r\nP") (let ((cbuf (current-buffer)) tempfile firstline work-buffer status) (save-excursion (goto-char start) ! (when (re-search-forward uudecode-begin-line nil t) (forward-line 1) (setq firstline (point)) (cond ((null file-name)) *************** *** 68,74 **** nil nil nil (match-string 1))))) (setq tempfile (expand-file-name ! (or file-name (concat uu-temporary-file-directory (make-temp-name "uu"))))) (let ((cdir default-directory) default-process-coding-system) (unwind-protect --- 73,79 ---- nil nil nil (match-string 1))))) (setq tempfile (expand-file-name ! (or file-name (concat uudecode-temporary-file-directory (make-temp-name "uu"))))) (let ((cdir default-directory) default-process-coding-system) (unwind-protect *************** *** 82,92 **** (apply 'call-process-region (point-min) (point-max) ! uu-decoder-program nil nil nil ! uu-decoder-switches)) (cd cdir) (set-buffer cbuf))) (if (file-exists-p tempfile) (unless file-name --- 87,97 ---- (apply 'call-process-region (point-min) (point-max) ! uudecode-decoder-program nil nil nil ! uudecode-decoder-switches)) (cd cdir) (set-buffer cbuf))) (if (file-exists-p tempfile) (unless file-name *************** *** 98,122 **** (and work-buffer (kill-buffer work-buffer)) (condition-case () (or file-name (delete-file tempfile)) ! (error))))) ! (defun uu-insert-char (char &optional count ignored buffer) (condition-case nil (progn (insert-char char count ignored buffer) ! (fset 'uu-insert-char 'insert-char)) (wrong-number-of-arguments ! (fset 'uu-insert-char 'uu-xemacs-insert-char) ! (uu-insert-char char count ignored buffer)))) ! (defun uu-xemacs-insert-char (char &optional count ignored buffer) (if (or (null buffer) (eq buffer (current-buffer))) (insert-char char count) (save-excursion (set-buffer buffer) (insert-char char count)))) ! (defun uu-decode-region (start end &optional file-name) (interactive "r\nP") (let ((work-buffer nil) (done nil) --- 103,132 ---- (and work-buffer (kill-buffer work-buffer)) (condition-case () (or file-name (delete-file tempfile)) ! (error)) ! ))) ! (defun uudecode-insert-char (char &optional count ignored buffer) (condition-case nil (progn (insert-char char count ignored buffer) ! (fset 'uudecode-insert-char 'insert-char)) (wrong-number-of-arguments ! (fset 'uudecode-insert-char 'uudecode-xemacs-insert-char) ! (uudecode-insert-char char count ignored buffer)))) ! (defun uudecode-xemacs-insert-char (char &optional count ignored buffer) (if (or (null buffer) (eq buffer (current-buffer))) (insert-char char count) (save-excursion (set-buffer buffer) (insert-char char count)))) ! ;;;###autoload ! ! (defun uudecode-decode-region (start end &optional file-name) ! "uudecode region between START and END. ! If FILE-NAME is non-nil, save the result to FILE-NAME." (interactive "r\nP") (let ((work-buffer nil) (done nil) *************** *** 124,134 **** (remain 0) (bits 0) (lim 0) inputpos ! (non-data-chars (concat "^" uu-alphabet))) (unwind-protect (save-excursion (goto-char start) ! (when (re-search-forward uu-begin-string nil t) (cond ((null file-name)) ((stringp file-name)) (t --- 134,144 ---- (remain 0) (bits 0) (lim 0) inputpos ! (non-data-chars (concat "^" uudecode-alphabet))) (unwind-protect (save-excursion (goto-char start) ! (when (re-search-forward uudecode-begin-line nil t) (cond ((null file-name)) ((stringp file-name)) (t *************** *** 144,150 **** (setq inputpos (point)) (setq remain 0 bits 0 counter 0) (cond ! ((> (skip-chars-forward uu-alphabet end) 0) (setq lim (point)) (setq remain (logand (- (char-int (char-after inputpos)) 32) 63)) --- 154,160 ---- (setq inputpos (point)) (setq remain 0 bits 0 counter 0) (cond ! ((> (skip-chars-forward uudecode-alphabet end) 0) (setq lim (point)) (setq remain (logand (- (char-int (char-after inputpos)) 32) 63)) *************** *** 159,168 **** (setq counter (1+ counter) inputpos (1+ inputpos)) (cond ((= counter 4) ! (uu-insert-char (lsh bits -16) 1 nil work-buffer) ! (uu-insert-char (logand (lsh bits -8) 255) 1 nil ! work-buffer) ! (uu-insert-char (logand bits 255) 1 nil work-buffer) (setq bits 0 counter 0)) (t (setq bits (lsh bits 6))))))) --- 169,179 ---- (setq counter (1+ counter) inputpos (1+ inputpos)) (cond ((= counter 4) ! (uudecode-insert-char ! (lsh bits -16) 1 nil work-buffer) ! (uudecode-insert-char ! (logand (lsh bits -8) 255) 1 nil work-buffer) ! (uudecode-insert-char (logand bits 255) 1 nil work-buffer) (setq bits 0 counter 0)) (t (setq bits (lsh bits 6))))))) *************** *** 172,186 **** (error "uucode line ends unexpectly") (setq done t)) ((and (= (point) end) (not done)) ! (error "uucode ends unexpectly") (setq done t)) ((= counter 3) ! (uu-insert-char (logand (lsh bits -16) 255) 1 nil work-buffer) ! (uu-insert-char (logand (lsh bits -8) 255) 1 nil work-buffer)) ((= counter 2) ! (uu-insert-char (logand (lsh bits -10) 255) 1 nil work-buffer))) (skip-chars-forward non-data-chars end)) (if file-name --- 183,197 ---- (error "uucode line ends unexpectly") (setq done t)) ((and (= (point) end) (not done)) ! ;(error "uucode ends unexpectly") (setq done t)) ((= counter 3) ! (uudecode-insert-char (logand (lsh bits -16) 255) 1 nil work-buffer) ! (uudecode-insert-char (logand (lsh bits -8) 255) 1 nil work-buffer)) ((= counter 2) ! (uudecode-insert-char (logand (lsh bits -10) 255) 1 nil work-buffer))) (skip-chars-forward non-data-chars end)) (if file-name *** pub/pgnus/lisp/ChangeLog Sun Oct 11 02:32:01 1998 --- pgnus/lisp/ChangeLog Tue Oct 20 00:27:04 1998 *************** *** 1,3 **** --- 1,199 ---- + Tue Oct 20 00:24:16 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.35 is released. + + 1998-10-20 00:00:36 Lars Magne Ingebrigtsen + + * uudecode.el (uudecode-decode-region-external): Insert + literally. + + * gnus-xmas.el (gnus-xmas-mime-button-menu): Moved here. + + * mm-bodies.el (mm-decode-body): Optional encoding. + + 1998-10-19 23:57:57 Lars Magne Ingebrigtsen + + * gnus-ems.el (gnus-mouse-3): New variable. + + * binhex.el (binhex-decode-region-external): Don't use -internally. + + 1998-10-16 14:54:02 Simon Josefsson + + * mailcap.el (mailcap-parse-mailcaps): Only open regular + files. + + 1998-09-26 22:28:01 Simon Josefsson + + * gnus-group.el (gnus-add-marked-articles): Request backend update + of flags. + + 1998-09-26 19:39:31 Simon Josefsson + + * gnus-sum.el (gnus-update-read-articles): + (gnus-update-marks): Request backend update of mark. + + 1998-09-26 19:33:58 Simon Josefsson + + * gnus.texi (Optional Backend Functions): New item, + nnchoke-request-set-mark. + + 1998-09-26 16:27:27 Simon Josefsson + + * gnus-range.el (gnus-remove-from-range): Don't add stuff in + list to range. + + 1998-10-19 23:45:13 Simon Josefsson + + * gnus-sum.el (gnus-summary-exit-no-update): Don't expire. + + 1998-10-14 SL Baur + + * gnus-sum.el: Move gnus-save-hidden-threads above where it is + first used. + + 1998-10-10 SL Baur + + * mm-view.el: Require mm-decode for macros. + + * mm-decode.el (mm-handle-type): Move macro declarations above the + place where they are used. + + Sun Oct 18 13:59:07 1998 Kurt Swanson + + * gnus-msg.el (gnus-summary-mail-forward): Erase old forward + buffer. + + 1998-10-19 23:38:11 Katsumi Yamaoka + + * nnagent.el (nnagent-open-server): Error message. + + 1998-10-19 23:35:08 Joerg Lenneis + + * nnheader.el (nnheader-article-p): Recognize lower-case headers. + + 1998-10-19 Hrvoje Niksic + + * score-mode.el (gnus-score-mode-map): Ditto. + + * message.el (message-mode-map): Ditto. + + * gnus-uu.el (gnus-uu-post-news): Ditto. + + * gnus-kill.el (gnus-kill-file-mode-map): Ditto. + + * gnus-eform.el (gnus-edit-form-mode-map): Ditto. + + * gnus-art.el (gnus-article-edit-mode-map): Use + `set-keymap-parent' rather than `copy-keymap'. + + 1998-10-18 Hrvoje Niksic + + * gnus-art.el (gnus-mime-button-commands): New variable. + (gnus-mime-button-map): Initialize it from + `gnus-mime-button-commands'. + (gnus-mime-button-menu): New function. + (gnus-insert-mime-button): Use `gnus-mime-button-map'. + + 1998-10-11 Hrvoje Niksic + + * message.el (message-insert-to): Make `nobody' and `poster' + synonymous to `never' and `always' in Mail-Copies-To. + (message-reply): Ditto. + (message-followup): Ditto. + + 1998-10-19 23:17:41 Lars Magne Ingebrigtsen + + * mailcap.el (mailcap-mime-data): Save sound. + + 1998-09-24 Hrvoje Niksic + + * message.el (message-ignored-supersedes-headers): Include + `NNTP-Posting-Date'. + + 1998-10-19 01:25:27 Jonas Steverud + + * gnus-art.el (gnus-article-dumbquotes-table): New variable. + + 1998-10-19 00:50:22 Lars Magne Ingebrigtsen + + * mm-bodies.el (mm-decode-content-transfer-encoding): Use + uudecode. + + 1998-10-18 18:20:34 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-display-external): Don't switch on save. + + 1998-10-18 18:14:06 Andy Piper + + * nnmail.el (nnmail-movemail-args): New variable. + + 1998-10-18 00:17:02 Lars Magne Ingebrigtsen + + * gnus-art.el (article-translate-strings): + + 1998-10-17 22:51:31 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-view-part): Use it. + (gnus-mm-display-part): New function. + (article-de-quoted-unreadable): Yse mm-default-coding-system. + + * mm-decode.el (mm-handle-displayed-p): New function. + + * gnus-art.el (gnus-mime-copy-part): Create better names. + (gnus-mime-button-line-format): Include dots spec. + + 1998-10-15 Matt Pharr + + * gnus-msg.el (gnus-summary-mail-forward): Erase contents of old + forward buffer first. + + 1998-10-17 21:16:46 Lars Magne Ingebrigtsen + + * gnus-util.el (gnus-set-window-start): New function. + + * message.el (message-send): Don't check changed. + + 1998-10-12 15:26:41 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-setup-buffer): Set params. + + * mm-decode.el (mm-user-display-methods): Inline + "message/delivery-status". + + 1998-10-11 07:06:38 Lars Magne Ingebrigtsen + + * message.el (message-auto-save-directory): Rename. + (message-mode): Dof fix. + + * gnus-art.el (gnus-summary-save-in-pipe): Default to "cat". + (gnus-summary-save-in-pipe): No, check gnus-last-shell-command. + + * nndoc.el (nndoc-mime-parts-type-p): Be a bit more forgiving. + + * message.el (message-make-date): Avoid locale. + + * gnus-art.el (gnus-article-edit-done): Allow update before doing + cache. + + * mm-decode.el (mm-display-inline): Goto point-min. + + * gnus-art.el (gnus-article-prepare-display): Not read-only. + + * mm-decode.el (mm-display-external): Reverse before sorting. + + * gnus-draft.el (gnus-draft-send): Allow mail. + + 1998-10-10 SL Baur + + * message.el (message-check): Move message-check macro above where + it is first used. + + * gnus-art.el (article-hide-pgp): Hide the PGP 5/GNUPG Hash: line. + + 1998-10-11 06:45:37 Lloyd Zusman + + * gnus-sum.el (gnus-summary-make-menu-bar): Fix. + Sun Oct 11 02:28:40 1998 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.34 is released. *************** *** 124,129 **** --- 320,329 ---- 1998-09-24 22:27:55 Lars Magne Ingebrigtsen * mm-decode.el (mm-inlinable-part-p): New function. + + 1998-09-25 22:28:01 Simon Josefsson + + * mm-util.el (mm-disable-multibyte): New function. Thu Sep 24 20:28:31 1998 Lars Magne Ingebrigtsen *** pub/pgnus/texi/emacs-mime.texi Sun Oct 11 02:32:08 1998 --- pgnus/texi/emacs-mime.texi Tue Oct 20 00:27:10 1998 *************** *** 86,125 **** read at least RFC2045 and RFC2047. @menu * Basic Functions:: Utility and basic parsing functions. * Decoding and Viewing:: A framework for decoding and viewing. * Index:: Function and variable index. @end menu ! @node Basic Functions ! @chapter Basic Functions ! This chapter describes the basic, ground-level functions for parsing and ! handling. Covered here is parsing @code{From} lines, removing comments ! from header lines, decoding encoded words, parsing date headers and so ! on. High-level functionality is dealt with in the next chapter ! (@pxref{Decoding and Viewing}). ! ! @menu ! * mail-parse:: The generalized @sc{mime} and mail interface. ! * rfc2231:: Parsing @code{Content-Type} headers. ! * drums:: Handling mail headers defined by RFC822bis. ! * rfc2047:: En/decoding encoded words in headers. ! * time-date:: Functions for parsing dates and manipulating time. ! * qp:: Quoted-Printable en/decoding. ! * base64:: Base64 en/decoding. ! * mailcap:: How parts are displayed is specified by the @file{.mailcap} file ! @end menu ! ! ! @node mail-parse ! @section mail-parse ! ! It is perhaps misleading to place the @code{mail-parse} library in this ! chapter. It is not a basic low-level library---rather, it is an ! abstraction over the actual low-level libraries that are described in the ! subsequent sections. Standards change, and so programs have to change to fit in the new mold. For instance, RFC2045 describes a syntax for the --- 86,106 ---- read at least RFC2045 and RFC2047. @menu + * Interface Functions:: An abstraction over the basic functions. * Basic Functions:: Utility and basic parsing functions. * Decoding and Viewing:: A framework for decoding and viewing. + * Standards:: A summary of RFCs and working documents used. * Index:: Function and variable index. @end menu ! @node Interface Functions ! @chapter Interface Functions ! @cindex interface functions ! @cindex mail-parse ! The @code{mail-parse} library is an abstraction over the actual ! low-level libraries that are described in the next chapter. Standards change, and so programs have to change to fit in the new mold. For instance, RFC2045 describes a syntax for the *************** *** 165,171 **** @example (mail-header-parse-content-type "image/gif; name=\"b980912.gif\"") ! => ("image/gif" (name . "b980912.gif")) @end example @item mail-header-parse-content-disposition --- 146,152 ---- @example (mail-header-parse-content-type "image/gif; name=\"b980912.gif\"") ! @result{} ("image/gif" (name . "b980912.gif")) @end example @item mail-header-parse-content-disposition *************** *** 181,187 **** @example (mail-content-type-get '("image/gif" (name . "b980912.gif")) 'name) ! => "b980912.gif" @end example @item mail-header-remove-comments --- 162,168 ---- @example (mail-content-type-get '("image/gif" (name . "b980912.gif")) 'name) ! @result{} "b980912.gif" @end example @item mail-header-remove-comments *************** *** 191,197 **** @example (mail-header-remove-comments "Gnus/5.070027 (Pterodactyl Gnus v0.27) (Finnish Landrace)") ! => "Gnus/5.070027 " @end example @item mail-header-remove-whitespace --- 172,178 ---- @example (mail-header-remove-comments "Gnus/5.070027 (Pterodactyl Gnus v0.27) (Finnish Landrace)") ! @result{} "Gnus/5.070027 " @end example @item mail-header-remove-whitespace *************** *** 202,208 **** @example (mail-header-remove-whitespace "image/gif; name=\"Name with spaces\"") ! => "image/gif;name=\"Name with spaces\"" @end example @item mail-header-get-comment --- 183,189 ---- @example (mail-header-remove-whitespace "image/gif; name=\"Name with spaces\"") ! @result{} "image/gif;name=\"Name with spaces\"" @end example @item mail-header-get-comment *************** *** 212,218 **** @example (mail-header-get-comment "Gnus/5.070027 (Pterodactyl Gnus v0.27) (Finnish Landrace)") ! => "Finnish Landrace" @end example @item mail-header-parse-address --- 193,199 ---- @example (mail-header-get-comment "Gnus/5.070027 (Pterodactyl Gnus v0.27) (Finnish Landrace)") ! @result{} "Finnish Landrace" @end example @item mail-header-parse-address *************** *** 223,229 **** @example (mail-header-parse-address "Hrvoje Niksic ") ! => ("hniksic@@srce.hr" . "Hrvoje Niksic") @end example @item mail-header-parse-addresses --- 204,210 ---- @example (mail-header-parse-address "Hrvoje Niksic ") ! @result{} ("hniksic@@srce.hr" . "Hrvoje Niksic") @end example @item mail-header-parse-addresses *************** *** 234,240 **** @example (mail-header-parse-addresses "Hrvoje Niksic , Steinar Bang ") ! => (("hniksic@@srce.hr" . "Hrvoje Niksic") ("sb@@metis.no" . "Steinar Bang")) @end example --- 215,221 ---- @example (mail-header-parse-addresses "Hrvoje Niksic , Steinar Bang ") ! @result{} (("hniksic@@srce.hr" . "Hrvoje Niksic") ("sb@@metis.no" . "Steinar Bang")) @end example *************** *** 268,274 **** @example (mail-encode-encoded-word-string "This is naïve, baby") ! => "This is =?iso-8859-1?q?na=EFve,?= baby" @end example @item mail-decode-encoded-word-region --- 249,255 ---- @example (mail-encode-encoded-word-string "This is naïve, baby") ! @result{} "This is =?iso-8859-1?q?na=EFve,?= baby" @end example @item mail-decode-encoded-word-region *************** *** 282,297 **** @example (mail-decode-encoded-word-string "This is =?iso-8859-1?q?na=EFve,?= baby") ! => "This is naïve, baby" @end example @end table ! Currently, @code{mail-parse} is an abstraction over @code{drums}, @code{rfc2047} and @code{rfc2231}. These are documented in the subsequent sections. @node rfc2231 @section rfc2231 --- 263,302 ---- @example (mail-decode-encoded-word-string "This is =?iso-8859-1?q?na=EFve,?= baby") ! @result{} "This is naïve, baby" @end example @end table ! Currently, @code{mail-parse} is an abstraction over @code{ietf-drums}, @code{rfc2047} and @code{rfc2231}. These are documented in the subsequent sections. + + @node Basic Functions + @chapter Basic Functions + + This chapter describes the basic, ground-level functions for parsing and + handling. Covered here is parsing @code{From} lines, removing comments + from header lines, decoding encoded words, parsing date headers and so + on. High-level functionality is dealt with in the next chapter + (@pxref{Decoding and Viewing}). + + @menu + * rfc2231:: Parsing @code{Content-Type} headers. + * ietf-drums:: Handling mail headers defined by RFC822bis. + * rfc2047:: En/decoding encoded words in headers. + * time-date:: Functions for parsing dates and manipulating time. + * qp:: Quoted-Printable en/decoding. + * base64:: Base64 en/decoding. + * binhex:: Binhex decoding. + * uudecode:: Uuencode decoding. + * rfc1843:: Decoding HZ-encoded text. + * mailcap:: How parts are displayed is specified by the @file{.mailcap} file + @end menu + + @node rfc2231 @section rfc2231 *************** *** 325,331 **** title*0*=us-ascii'en'This%20is%20even%20more%20; title*1*=%2A%2A%2Afun%2A%2A%2A%20; title*2=\"isn't it!\"") ! => ("application/x-stuff" (title . "This is even more ***fun*** isn't it!")) @end example --- 330,336 ---- title*0*=us-ascii'en'This%20is%20even%20more%20; title*1*=%2A%2A%2Afun%2A%2A%2A%20; title*2=\"isn't it!\"") ! @result{} ("application/x-stuff" (title . "This is even more ***fun*** isn't it!")) @end example *************** *** 337,344 **** @end table ! @node drums ! @section drums @dfn{drums} is an IETF working group that is working on the replacement for RFC822. --- 342,349 ---- @end table ! @node ietf-drums ! @section ietf-drums @dfn{drums} is an IETF working group that is working on the replacement for RFC822. *************** *** 346,380 **** The functions provided by this library include: @table @code ! @item drums-remove-comments ! @findex drums-remove-comments Remove the comments from the argument and return the results. ! @item drums-remove-whitespace ! @findex drums-remove-whitespace Remove linear white space from the string and return the results. Spaces inside quoted strings and comments are left untouched. ! @item drums-get-comment ! @findex drums-get-comment Return the last most comment from the string. ! @item drums-parse-address ! @findex drums-parse-address Parse an address string and return a list that contains the mailbox and the plain text name. ! @item drums-parse-addresses ! @findex drums-parse-addresses Parse a string that contains any number of comma-separated addresses and return a list that contains mailbox/plain text pairs. ! @item drums-parse-date ! @findex drums-parse-date Parse a date string and return an Emacs time structure. ! @item drums-narrow-to-header ! @findex drums-narrow-to-header Narrow the buffer to the header section of the current buffer. @end table --- 351,385 ---- The functions provided by this library include: @table @code ! @item ietf-drums-remove-comments ! @findex ietf-drums-remove-comments Remove the comments from the argument and return the results. ! @item ietf-drums-remove-whitespace ! @findex ietf-drums-remove-whitespace Remove linear white space from the string and return the results. Spaces inside quoted strings and comments are left untouched. ! @item ietf-drums-get-comment ! @findex ietf-drums-get-comment Return the last most comment from the string. ! @item ietf-drums-parse-address ! @findex ietf-drums-parse-address Parse an address string and return a list that contains the mailbox and the plain text name. ! @item ietf-drums-parse-addresses ! @findex ietf-drums-parse-addresses Parse a string that contains any number of comma-separated addresses and return a list that contains mailbox/plain text pairs. ! @item ietf-drums-parse-date ! @findex ietf-drums-parse-date Parse a date string and return an Emacs time structure. ! @item ietf-drums-narrow-to-header ! @findex ietf-drums-narrow-to-header Narrow the buffer to the header section of the current buffer. @end table *************** *** 470,476 **** and manipulating time. (Not by using tesseracts, though, I'm sorry to say.) ! These functions converts between five formats: A date string, an Emacs time structure, a decoded time list, a second number, and a day number. The functions have quite self-explanatory names, so the following just --- 475,481 ---- and manipulating time. (Not by using tesseracts, though, I'm sorry to say.) ! These functions convert between five formats: A date string, an Emacs time structure, a decoded time list, a second number, and a day number. The functions have quite self-explanatory names, so the following just *************** *** 478,518 **** @example (parse-time-string "Sat Sep 12 12:21:54 1998 +0200") ! => (54 21 12 12 9 1998 6 nil 7200) (date-to-time "Sat Sep 12 12:21:54 1998 +0200") ! => (13818 19266) (time-to-seconds '(13818 19266)) ! => 905595714.0 (seconds-to-time 905595714.0) ! => (13818 19266 0) (time-to-day '(13818 19266)) ! => 729644 (days-to-time 729644) ! => (961933 65536) (time-since '(13818 19266)) ! => (0 430) (time-less-p '(13818 19266) '(13818 19145)) ! => nil (subtract-time '(13818 19266) '(13818 19145)) ! => (0 121) (days-between "Sat Sep 12 12:21:54 1998 +0200" "Sat Sep 07 12:21:54 1998 +0200") ! => 5 (date-leap-year-p 2000) ! => t (time-to-day-in-year '(13818 19266)) ! => 255 @end example --- 483,523 ---- @example (parse-time-string "Sat Sep 12 12:21:54 1998 +0200") ! @result{} (54 21 12 12 9 1998 6 nil 7200) (date-to-time "Sat Sep 12 12:21:54 1998 +0200") ! @result{} (13818 19266) (time-to-seconds '(13818 19266)) ! @result{} 905595714.0 (seconds-to-time 905595714.0) ! @result{} (13818 19266 0) (time-to-day '(13818 19266)) ! @result{} 729644 (days-to-time 729644) ! @result{} (961933 65536) (time-since '(13818 19266)) ! @result{} (0 430) (time-less-p '(13818 19266) '(13818 19145)) ! @result{} nil (subtract-time '(13818 19266) '(13818 19145)) ! @result{} (0 121) (days-between "Sat Sep 12 12:21:54 1998 +0200" "Sat Sep 07 12:21:54 1998 +0200") ! @result{} 5 (date-leap-year-p 2000) ! @result{} t (time-to-day-in-year '(13818 19266)) ! @result{} 255 @end example *************** *** 559,564 **** --- 564,570 ---- @node base64 @section base64 + @cindex base64 Base64 is an encoding that encodes three bytes into four characters, thereby increasing the size by about 33%. The alphabet used for *************** *** 591,596 **** --- 597,665 ---- @end table + @node binhex + @section binhex + @cindex binhex + @cindex Apple + @cindex Macintosh + + @code{binhex} is an encoding that originated in Macintosh environments. + The following function is supplied to deal with these: + + @table @code + @item binhex-decode-region + @findex binhex-decode-region + Decode the encoded text in the region. If given a third parameter, only + decode the @code{binhex} header and return the filename. + + @end table + + + @node uudecode + @section uudecode + @cindex uuencode + @cindex uudecode + + @code{uuencode} is probably still the most popular encoding of binaries + used on Usenet, although @code{base64} rules the mail world. + + The following function is supplied by this package: + + @table @code + @item uudecode-decode-region + @findex uudecode-decode-region + Decode the text in the region. + @end table + + + @node rfc1843 + @section rfc1843 + @cindex rfc1843 + @cindex HZ + @cindex Chinese + + RFC1843 deals with mixing Chinese and ASCII characters in messages. In + essence, RFC1843 switches between ASCII and Chinese by doing this: + + @example + This sentence is in ASCII. + The next sentence is in GB.~@{<:Ky2;S@{#,NpJ)l6HK!#~@}Bye. + @end example + + Simple enough, and widely used in China. + + The following functions are available to handle this encoding: + + @table @code + @item rfc1843-decode-region + Decode HZ-encoded text in the region. + + @item rfc1843-decode-string + Decode a HZ-encoded string and return the result. + + @end table + + @node mailcap @section mailcap *************** *** 599,606 **** Here's an example file: @example ! image/*; xv -8 %s ! audio/x-pn-realaudio; rvplayer %s @end example This says that all image files should be displayed with @samp{xv}, and --- 668,675 ---- Here's an example file: @example ! image/*; gimp -8 %s ! audio/wav; wavplayer %s @end example This says that all image files should be displayed with @samp{xv}, and *************** *** 743,748 **** --- 812,865 ---- @end table + @node Standards + @chapter Standards + + The Emacs @sc{mime} library implements handling of various elements + according to a (somewhat) large number of RFCs, drafts and standards + documents. This chapter lists the relevant ones. They can all be + fetched from @samp{http://www.stud.ifi.uio.no/~larsi/notes/}. + + @table @dfn + @item RFC822 + @itemx STD11 + Standard for the Format of ARPA Internet Text Messages. + + @item RFC1036 + Standard for Interchange of USENET Messages + + @item RFC2045 + Format of Internet Message Bodies + + @item RFC2046 + Media Types + + @item RFC2047 + Message Header Extensions for Non-ASCII Text + + @item RFC2048 + Registration Procedures + + @item RFC2049 + Conformance Criteria and Examples + + @item RFC2231 + MIME Parameter Value and Encoded Word Extensions: Character Sets, + Languages, and Continuations + + @item RFC1843 + HZ - A Data Format for Exchanging Files of Arbitrarily Mixed Chinese and + ASCII characters + + @item draft-ietf-drums-msg-fmt-05.txt + Draft for the successor of RFC822 + + @item RFC1892 + The Multipart/Report Content Type for the Reporting of Mail System + Administrative Messages + + @end table + @node Index @chapter Index *** pub/pgnus/texi/gnus.texi Sun Oct 11 02:32:09 1998 --- pgnus/texi/gnus.texi Tue Oct 20 00:27:11 1998 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @setfilename gnus ! @settitle Pterodactyl Gnus 0.34 Manual @synindex fn cp @synindex vr cp @synindex pg cp --- 1,7 ---- \input texinfo @c -*-texinfo-*- @setfilename gnus ! @settitle Pterodactyl Gnus 0.35 Manual @synindex fn cp @synindex vr cp @synindex pg cp *************** *** 318,324 **** @tex @titlepage ! @title Pterodactyl Gnus 0.34 Manual @author by Lars Magne Ingebrigtsen @page --- 318,324 ---- @tex @titlepage ! @title Pterodactyl Gnus 0.35 Manual @author by Lars Magne Ingebrigtsen @page *************** *** 354,360 **** spool or your mbox file. All at the same time, if you want to push your luck. ! This manual corresponds to Pterodactyl Gnus 0.34. @end ifinfo --- 354,360 ---- spool or your mbox file. All at the same time, if you want to push your luck. ! This manual corresponds to Pterodactyl Gnus 0.35. @end ifinfo *************** *** 823,828 **** --- 823,832 ---- gnus-group-clear-data-on-native-groups} command to clear out all data that you have on your native groups. Use with caution. + After changing servers, you @strong{must} move the cache hierarchy away, + since the cached articles will have wrong article numbers, which will + affect which articles Gnus thinks are read. + @node Startup Files @section Startup Files *************** *** 6477,6483 **** @item W d @kindex W d (Summary) @findex gnus-article-treat-dumbquotes ! Treat M******** sm*rtq**t*s (@code{gnus-article-treat-dumbquotes}). @item W w @kindex W w (Summary) --- 6481,6493 ---- @item W d @kindex W d (Summary) @findex gnus-article-treat-dumbquotes ! @vindex gnus-article-dumbquotes-map ! @cindex Smartquotes ! @cindex M******** sm*rtq**t*s ! @cindex Latin 1 ! Treat M******** sm*rtq**t*s according to ! @code{gnus-article-dumbquotes-map} ! (@code{gnus-article-treat-dumbquotes}). @item W w @kindex W w (Summary) *************** *** 14572,14577 **** --- 14582,14592 ---- ``right'' window configuration, you can set @code{gnus-always-force-window-configuration} to non-@code{nil}. + If you're using tree displays (@pxref{Tree Display}), and the tree + window is displayed vertically next to another window, you may also want + to fiddle with @code{gnus-tree-minimize-window} to avoid having the + windows resized. + @node Faces and Fonts @section Faces and Fonts *************** *** 17576,17582 **** new group parameter -- `post-to-server' that says to post using the current server. Also a variable to do the same. @item ! the slave dribble files should autosave to the slave file names. @item a group parameter that says what articles to display on group entry, based on article marks. --- 17591,17597 ---- new group parameter -- `post-to-server' that says to post using the current server. Also a variable to do the same. @item ! the slave dribble files should auto-save to the slave file names. @item a group parameter that says what articles to display on group entry, based on article marks. *************** *** 18050,18056 **** add a way to select which NoCeM type to apply -- spam, troll, etc. @item ! nndraft-request-group should tally autosave files. @item implement nntp-retry-on-break and nntp-command-timeout. --- 18065,18071 ---- add a way to select which NoCeM type to apply -- spam, troll, etc. @item ! nndraft-request-group should tally auto-save files. @item implement nntp-retry-on-break and nntp-command-timeout. *************** *** 18805,18811 **** @lisp (gnus-check-backend-function "request-scan" "nnml:misc") ! => t @end lisp @item gnus-read-method --- 18820,18826 ---- @lisp (gnus-check-backend-function "request-scan" "nnml:misc") ! @result{} t @end lisp @item gnus-read-method *************** *** 19147,19152 **** --- 19162,19209 ---- There should be no result data from this function. + @item (nnchoke-request-set-mark GROUP ACTION &optional SERVER) + + Set/remove/add marks on articles. Normally Gnus handles the article + marks (such as read, ticked, expired etc) internally, and store them in + @code{~/.newsrc.eld}. Some backends (such as IMAP) however carry all + information about the articles on the server, so Gnus need to propagate + the mark information to the server. + + ACTION is a list of mark setting requests, having this format: + + @example + (RANGE ACTION MARK) + @end example + + Range is a range of articles you wish to update marks on. Action is + @code{set}, @code{add} or @code{del}, respectively used for removing all + existing marks and setting them as specified, adding (preserving the + marks not mentioned) mark and removing (preserving the marks not + mentioned) marks. Mark is a list of marks; where each mark is a + symbol. Currently used marks are @code{read}, @code{tick}, @code{reply}, + @code{expire}, @code{killed}, @code{dormant}, @code{save}, + @code{download} and @code{unsend}, but your backend should, if possible, + not limit itself to theese. + + Given contradictory actions, the last action in the list should be the + effective one. That is, if your action contains a request to add the + @code{tick} mark on article 1 and, later in the list, a request to + remove the mark on the same article, the mark should in fact be removed. + + An example action list: + + @example + (((5 12 30) 'del '(tick)) + ((10 . 90) 'add '(read expire)) + ((92 94) 'del '(read))) + @end example + + The function should return a range of articles it wasn't able to set the + mark on (currently not used for anything). + + There should be no result data from this function. + @item (nnchoke-request-update-mark GROUP ARTICLE MARK) If the user tries to set a mark that the backend doesn't like, this *************** *** 19772,19778 **** second is a more complex one: @example ! ("no.group" 5 (1 . 54324)) ("nnml:my.mail" 3 ((1 . 5) 9 (20 . 55)) ((tick (15 . 19)) (replied 3 6 (19 . 3))) --- 19829,19835 ---- second is a more complex one: @example ! ("no.group" 5 ((1 . 54324))) ("nnml:my.mail" 3 ((1 . 5) 9 (20 . 55)) ((tick (15 . 19)) (replied 3 6 (19 . 3))) *** pub/pgnus/texi/message.texi Sun Oct 11 02:32:09 1998 --- pgnus/texi/message.texi Tue Oct 20 00:27:12 1998 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @setfilename message ! @settitle Pterodactyl Message 0.34 Manual @synindex fn cp @synindex vr cp @synindex pg cp --- 1,7 ---- \input texinfo @c -*-texinfo-*- @setfilename message ! @settitle Pterodactyl Message 0.35 Manual @synindex fn cp @synindex vr cp @synindex pg cp *************** *** 42,48 **** @tex @titlepage ! @title Pterodactyl Message 0.34 Manual @author by Lars Magne Ingebrigtsen @page --- 42,48 ---- @tex @titlepage ! @title Pterodactyl Message 0.35 Manual @author by Lars Magne Ingebrigtsen @page *************** *** 83,89 **** * Key Index:: List of Message mode keys. @end menu ! This manual corresponds to Pterodactyl Message 0.34. Message is distributed with the Gnus distribution bearing the same version number as this manual. --- 83,89 ---- * Key Index:: List of Message mode keys. @end menu ! This manual corresponds to Pterodactyl Message 0.35. Message is distributed with the Gnus distribution bearing the same version number as this manual. *** pub/pgnus/texi/ChangeLog Sun Oct 11 02:32:09 1998 --- pgnus/texi/ChangeLog Tue Oct 20 00:27:12 1998 *************** *** 1,3 **** --- 1,19 ---- + 1998-10-15 18:15:34 Simon Josefsson + + * gnus.texi (Group Info): Must be list of ranges. + + 1998-10-19 01:27:26 Lars Magne Ingebrigtsen + + * gnus.texi (Article Washing): Addition. + + 1998-10-18 00:20:58 Lars Magne Ingebrigtsen + + * gnus.texi (Changing Servers): Addition. + + 1998-10-17 21:34:57 Lars Magne Ingebrigtsen + + * gnus.texi (Windows Configuration): Addition. + 1998-10-01 07:55:35 Lars Magne Ingebrigtsen * gnus.texi (Splitting Mail): Fix.