From c9aef86c3ca1504b71ba25898d188b338b7339af Mon Sep 17 00:00:00 2001 From: yamaoka Date: Sun, 31 Jan 1999 23:15:05 +0000 Subject: [PATCH] * gnus-offline.el: Rewrite to work with pGnus v0.74 based T-gnus. * gnus-ofsetup.el: Ditto. * pop3-fma.el: Removed because after pGnus0.73 , pGnus can treat multiple pop3 account. * read-password.el: New file. * gnus.el (running-pterodactyl-gnus-0_73-or-later): Provide as a new feature. * mail-source.el (mail-source-read-passwd): Don't load "passwd" if the function `read-passwd' already exists. * gnus-start.el (gnus-read-active-file): Eliminate duplicated select methods. * gnus-group.el (gnus-group-catchup-current): Fix typo. * gnus.el (gnus-version-number): Update to 6.10.056. * Sync up with Pterodactyl Gnus v0.74. --- lisp/gnus-ofsetup.el | 142 ++++++++++------- lisp/gnus-picon.el | 14 +- lisp/gnus-score.el | 27 ++-- lisp/gnus-start.el | 59 +++---- lisp/gnus-sum.el | 18 ++- lisp/gnus-topic.el | 3 +- lisp/gnus-util.el | 17 +- lisp/gnus-uu.el | 3 +- lisp/gnus-win.el | 6 +- lisp/gnus-xmas.el | 2 +- lisp/gnus.el | 19 +-- lisp/mail-source.el | 61 ++++--- lisp/message.el | 26 +-- lisp/messagexmas.el | 2 +- lisp/mm-bodies.el | 3 +- lisp/mm-decode.el | 17 +- lisp/mm-util.el | 28 ++-- lisp/mm-uu.el | 8 +- lisp/mm-view.el | 15 +- lisp/nnbabyl.el | 3 +- lisp/nndoc.el | 3 +- lisp/nneething.el | 6 +- lisp/nnfolder.el | 3 +- lisp/nnheader.el | 7 +- lisp/nnmail.el | 432 ++++++-------------------------------------------- lisp/nntp.el | 3 +- lisp/nnvirtual.el | 3 +- lisp/parse-time.el | 2 +- lisp/pop3-fma.el | 412 ----------------------------------------------- lisp/pop3.el | 2 +- lisp/rfc2047.el | 15 +- lisp/smiley.el | 10 +- 32 files changed, 376 insertions(+), 995 deletions(-) delete mode 100644 lisp/pop3-fma.el diff --git a/lisp/gnus-ofsetup.el b/lisp/gnus-ofsetup.el index 1dd7785..dcbadfe 100644 --- a/lisp/gnus-ofsetup.el +++ b/lisp/gnus-ofsetup.el @@ -1,6 +1,6 @@ ;;; gnus-ofsetup.el --- Setup advisor for Offline reading for Mail/News. ;;; -;;; $Id: gnus-ofsetup.el,v 1.1.2.8 1998-12-11 15:54:35 ichikawa Exp $ +;;; $Id: gnus-ofsetup.el,v 1.1.2.9 1999-01-31 23:14:36 yamaoka Exp $ ;;; ;;; Copyright (C) 1998 Tatsuya Ichikawa ;;; Author: Tatsuya Ichikawa @@ -41,8 +41,9 @@ (defvar pop3-fma-movemail-type nil) (defvar pop3-fma-movemail-arguments nil) (defvar use-miee nil) -(defvar address) -(defvar options) +(defvar address nil) +(defvar mail-source nil) +(defvar options nil) ;;; To silence byte compiler (and @@ -172,43 +173,65 @@ ;; Set E-Mail Address and pop3 movemail type. (setq i (string-to-int num-of-address)) (setq address nil) - (while (> i 0) - (setq address - (append address - (list - (list - (concat "po:" - (read-from-minibuffer - "Email address (user@mailhost): ")) - (completing-read - "Authentification Method (TAB to completion): " - '(("pass" 1) ("apop" 2)) nil t nil))))) - (setq i (- i 1))) - - ;; Replace "hoge" -> 'hoge - (mapcar - (lambda (x) - (if (string-equal (nth 1 x) "pass") - (setcar (cdr x) 'pass) - (setcar (cdr x) 'apop))) - address) - (setq pop3-fma-spool-file-alist address) - - ;; Set movemail type. - (let ((movemail-type - (completing-read - "Select movemail type for retreave mail (TAB to completion): " - '(("exe" 1) ("lisp" 2)) - nil t nil)) - ) - (if (string-equal movemail-type "exe") - (let ((options - (read-from-minibuffer "movemail options: "))) - (setq pop3-fma-movemail-arguments (split-string options "[\t ]+")))) - (if (string-equal movemail-type "exe") - (setq pop3-fma-movemail-type 'exe) - (setq pop3-fma-movemail-type 'lisp)))) - + (if (not (locate-library "mail-source")) + (progn + (while (> i 0) + (setq address + (append address + (list + (list + (concat "po:" + (read-from-minibuffer + "Email address (user@mailhost): ")) + (completing-read + "Authentification Method (TAB to completion): " + '(("pass" 1) ("apop" 2)) nil t nil))))) + (setq i (- i 1))) + ;; Replace "hoge" -> 'hoge + (mapcar + (lambda (x) + (if (string-equal (nth 1 x) "pass") + (setcar (cdr x) 'pass) + (setcar (cdr x) 'apop))) + address) + (setq pop3-fma-spool-file-alist address) + ;; Set movemail type. + (let ((movemail-type + (completing-read + "Select movemail type for retreave mail (TAB to completion): " + '(("exe" 1) ("lisp" 2)) + nil t nil)) + ) + (if (string-equal movemail-type "exe") + (let ((options + (read-from-minibuffer "movemail options: "))) + (setq pop3-fma-movemail-arguments (split-string options "[\t ]+")))) + (if (string-equal movemail-type "exe") + (setq pop3-fma-movemail-type 'exe) + (setq pop3-fma-movemail-type 'lisp)))) + ;; + ;; Use mail-source.el + (setq mail-source nil) + (while (> i 0) + (setq user (read-from-minibuffer "Mail Account name : ")) + (setq server (read-from-minibuffer "Mail server : ")) + (setq auth (completing-read + "Authentification Method (TAB to completion): " + '(("pop" 1) ("apop" 2)) nil t nil)) + (setq mail-source + (append mail-source + (list + (list + auth :user user :server server)))) + (setq i (- i 1))) + ;; Replace "hoge" -> 'hoge + (mapcar + (lambda (x) + (if (string-equal (nth 0 x) "pop") + (setcar x 'pop) + (setcar x 'apop))) + mail-source) + (setq gnus-offline-mail-source mail-source))) ;; Write to setting file. (setq tmp-buffer (get-buffer-create "* Setting")) (set-buffer "* Setting") @@ -283,7 +306,6 @@ ;; Offline setting for gnus-nntp-* (insert "(setq gnus-nntp-service nil)\n") (insert "(setq gnus-nntp-server nil)\n") - (insert "(setq nnmail-spool-file nil)\n") ;; Write setting about hooks. (insert "(add-hook 'gnus-group-mode-hook 'gnus-offline-processed-by-timer t)\n") @@ -296,20 +318,32 @@ (insert "(autoload 'gnus-offline-setup \"gnus-offline\")\n") (insert "(add-hook 'gnus-load-hook 'gnus-offline-setup)\n") - ;; Write setting about pop3-fma. - (insert "(require 'pop3-fma)\n") - (insert "(add-hook 'message-send-hook 'pop3-fma-message-add-header)\n") - (insert "(setq pop3-fma-spool-file-alist '") - (insert (prin1-to-string pop3-fma-spool-file-alist)) - (insert ")\n") - (insert "(setq pop3-fma-movemail-type '") - (insert (prin1-to-string pop3-fma-movemail-type)) - (insert ")\n") - (if (eq pop3-fma-movemail-type 'exe) + (if (not (locate-library "mail-source")) (progn - (insert "(setq pop3-fma-movemail-arguments '") - (insert (prin1-to-string pop3-fma-movemail-arguments)) - (insert ")\n"))) + ;; Write setting about pop3-fma. + (insert "(setq nnmail-spool-file nil)\n") + (insert "(require 'pop3-fma)\n") + (insert "(add-hook 'message-send-hook 'pop3-fma-message-add-header)\n") + (insert "(setq pop3-fma-spool-file-alist '") + (insert (prin1-to-string pop3-fma-spool-file-alist)) + (insert ")\n") + (insert "(setq pop3-fma-movemail-type '") + (insert (prin1-to-string pop3-fma-movemail-type)) + (insert ")\n") + (if (eq pop3-fma-movemail-type 'exe) + (progn + (insert "(setq pop3-fma-movemail-arguments '") + (insert (prin1-to-string pop3-fma-movemail-arguments)) + (insert ")\n")))) + ;; Write stting about mail-source.el + (insert "(setq gnus-offline-mail-source '") + (insert (prin1-to-string gnus-offline-mail-source)) + (insert ")\n") + (insert "(setq nnmail-spool-file gnus-offline-mail-source)\n") + (insert "(require 'read-passwd)\n") + (insert "(setq mail-source-read-passwd 'read-pw-read-passwd)\n") + (insert "(add-hook 'gnus-before-startup-hook 'read-pw-set-mail-source-passwd-cache)\n"); + ) (write-region (point-min) (point-max) gnus-offline-setting-file) (kill-buffer "* Setting")) ) diff --git a/lisp/gnus-picon.el b/lisp/gnus-picon.el index 9d31d58..f5e7073 100644 --- a/lisp/gnus-picon.el +++ b/lisp/gnus-picon.el @@ -42,7 +42,7 @@ variable." (defcustom gnus-picons-display-where 'picons "Where to display the group and article icons. -Legal values are `article' and `picons'." +Valid values are `article' and `picons'." :type '(choice symbol string) :group 'picons) @@ -375,9 +375,9 @@ To use: (setq gnus-article-x-face-command 'gnus-picons-display-x-face)" (gnus-put-text-property (match-beginning 0) (match-end 0) 'invisible t) - (goto-char (point-min)) - (search-forward "\n\n") - (backward-char 1)))) + (article-goto-body) + (unless (bobp) + (backward-char 1))))) (if (null gnus-picons-piconsearch-url) (gnus-picons-display-pairs (gnus-picons-lookup-pairs @@ -595,7 +595,8 @@ none, and whose CDR is the corresponding element of DOMAINS." ;; dbs "^\\(" (mapconcat 'identity dbs "\\|") "\\)/" ;; host - "\\(\\(" (replace-in-string host "\\." "/\\|" t) "/\\|MISC/\\)*\\)" + "\\(\\(" (replace-in-string host "\\." "/\\|" t) + "/\\|MISC/\\)*\\)" ;; user "\\(" (regexp-quote user) "\\|unknown\\)/" "face\\.")) @@ -647,7 +648,8 @@ none, and whose CDR is the corresponding element of DOMAINS." ;; only do the job if it has not been preempted. (if (equal gnus-picons-job-already-running (list sym-ann 'picon url part right-p marker)) - (gnus-picons-network-display-internal sym-ann glyph part right-p marker) + (gnus-picons-network-display-internal + sym-ann glyph part right-p marker) (gnus-picons-next-job-internal)))) (defun gnus-picons-network-display (url part sym-ann right-p marker) diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index 90de3ec..e4fa63e 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -556,7 +556,7 @@ used as score." (gnus-score-kill-help-buffer) (unless (setq entry (assq (downcase hchar) char-to-header)) (if mimic (error "%c %c" prefix hchar) - (error "Illegal header type"))) + (error "Invalid header type"))) (when (/= (downcase hchar) hchar) ;; This was a majuscule, so we end reading and set the defaults. @@ -589,7 +589,7 @@ used as score." (gnus-score-kill-help-buffer) (unless (setq type (nth 1 (assq (downcase tchar) legal-types))) (if mimic (error "%c %c" prefix hchar) - (error "Illegal match type")))) + (error "Invalid match type")))) (when (/= (downcase tchar) tchar) ;; It was a majuscule, so we end reading and use the default. @@ -622,7 +622,7 @@ used as score." (error "You rang?")) (if mimic (error "%c %c %c %c" prefix hchar tchar pchar) - (error "Illegal match duration")))) + (error "Invalid match duration")))) ;; Always kill the score help buffer. (gnus-score-kill-help-buffer)) @@ -1277,11 +1277,11 @@ EXTRA is the possible non-standard header." err (cond ((not (listp (car a))) - (format "Illegal score element %s in %s" (car a) file)) + (format "Invalid score element %s in %s" (car a) file)) ((stringp (caar a)) (cond ((not (listp (setq sr (cdar a)))) - (format "Illegal header match %s in %s" (nth 1 (car a)) file)) + (format "Invalid header match %s in %s" (nth 1 (car a)) file)) (t (setq type (caar a)) (while (and sr (not err)) @@ -1292,7 +1292,7 @@ EXTRA is the possible non-standard header." ((if (member (downcase type) '("lines" "chars")) (not (numberp (car s))) (not (stringp (car s)))) - (format "Illegal match %s in %s" (car s) file)) + (format "Invalid match %s in %s" (car s) file)) ((and (cadr s) (not (integerp (cadr s)))) (format "Non-integer score %s in %s" (cadr s) file)) ((and (caddr s) (not (integerp (caddr s)))) @@ -1573,7 +1573,7 @@ EXTRA is the possible non-standard header." (match-func (if (or (eq type '>) (eq type '<) (eq type '<=) (eq type '>=) (eq type '=)) type - (error "Illegal match type: %s" type))) + (error "Invalid match type: %s" type))) (articles gnus-scores-articles)) ;; Instead of doing all the clever stuff that ;; `gnus-score-string' does to minimize searches and stuff, @@ -1633,7 +1633,7 @@ EXTRA is the possible non-standard header." ((eq type 'regexp) (setq match-func 'string-match match (nth 0 kill))) - (t (error "Illegal match type: %s" type))) + (t (error "Invalid match type: %s" type))) ;; Instead of doing all the clever stuff that ;; `gnus-score-string' does to minimize searches and stuff, ;; I will assume that people generally will put so few @@ -1731,7 +1731,7 @@ EXTRA is the possible non-standard header." (eq type 'string) (eq type 'String)) 'search-forward) (t - (error "Illegal match type: %s" type))))) + (error "Invalid match type: %s" type))))) (goto-char (point-min)) (when (funcall search-func match nil t) ;; Found a match, update scores. @@ -1817,7 +1817,7 @@ EXTRA is the possible non-standard header." (search-func (cond ((= dmt ?r) 're-search-forward) ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward) - (t (error "Illegal match type: %s" type)))) + (t (error "Invalid match type: %s" type)))) arts art) (goto-char (point-min)) (if (= dmt ?e) @@ -1950,7 +1950,7 @@ EXTRA is the possible non-standard header." (mt (aref (symbol-name type) 0)) (case-fold-search (not (memq mt '(?R ?S ?E ?F)))) (dmt (downcase mt)) - ; Assume user already simplified regexp and fuzzies + ;; Assume user already simplified regexp and fuzzies (match (if (and simplify (not (memq dmt '(?f ?r)))) (gnus-map-function gnus-simplify-subject-functions @@ -1960,11 +1960,12 @@ EXTRA is the possible non-standard header." (cond ((= dmt ?r) 're-search-forward) ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward) ((= dmt ?w) nil) - (t (error "Illegal match type: %s" type))))) + (t (error "Invalid match type: %s" type))))) ;; Evil hackery to make match usable in non-standard headers. (when extra - (setq match (concat "[ (](" extra " \\. \"[^)]*" match "[^(]*\")[ )]") + (setq match (concat "[ (](" extra " \\. \"[^)]*" + match "[^(]*\")[ )]") search-func 're-search-forward)) ; XXX danger?!? (cond diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 6ef943a..4648e59 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1446,7 +1446,7 @@ newsgroup." ;; Then we want to peel off any elements that are higher ;; than the upper active limit. (let ((srange range)) - ;; Go past all legal elements. + ;; Go past all valid elements. (while (and (cdr srange) (<= (or (and (atom (cadr srange)) (cadr srange)) @@ -1454,7 +1454,7 @@ newsgroup." (cdr active))) (setq srange (cdr srange))) (when (cdr srange) - ;; Nuke all remaining illegal elements. + ;; Nuke all remaining invalid elements. (setcdr srange nil)) ;; Adjust the final element. @@ -1519,10 +1519,14 @@ newsgroup." "-request-update-info"))) (inline (gnus-request-update-info info method)))) ;; These groups are native or secondary. - (when (and (<= (gnus-info-level info) level) - (not gnus-read-active-file)) + (cond + ;; We don't want these groups. + ((> (gnus-info-level info) level) + (setq active nil)) + ;; Activate groups. + ((not gnus-read-active-file) (setq active (gnus-activate-group group 'scan)) - (inline (gnus-close-group group)))) + (inline (gnus-close-group group))))) ;; Get the number of unread articles in the group. (if active @@ -1638,30 +1642,30 @@ newsgroup." (defun gnus-read-active-file (&optional force not-native) (gnus-group-set-mode-line) (let ((methods - (append - (if (and (not not-native) - (gnus-check-server gnus-select-method)) - ;; The native server is available. - (cons gnus-select-method gnus-secondary-select-methods) - ;; The native server is down, so we just do the - ;; secondary ones. - gnus-secondary-select-methods) - ;; Also read from the archive server. - (when (gnus-archive-server-wanted-p) - (list "archive")))) - list-type) + (mapcar + (lambda (m) (if (stringp m) (gnus-server-get-method nil m) m)) + (append + (if (and (not not-native) + (gnus-check-server gnus-select-method)) + ;; The native server is available. + (cons gnus-select-method gnus-secondary-select-methods) + ;; The native server is down, so we just do the + ;; secondary ones. + gnus-secondary-select-methods) + ;; Also read from the archive server. + (when (gnus-archive-server-wanted-p) + (list "archive"))))) + method where mesg list-type) (setq gnus-have-read-active-file nil) (save-excursion (set-buffer nntp-server-buffer) - (while methods - (let* ((method (if (stringp (car methods)) - (gnus-server-get-method nil (car methods)) - (car methods))) - (where (nth 1 method)) - (mesg (format "Reading active file%s via %s..." + (while (setq method (pop methods)) + (unless (member method methods) + (setq where (nth 1 method) + mesg (format "Reading active file%s via %s..." (if (and where (not (zerop (length where)))) (concat " from " where) "") - (car method)))) + (car method))) (gnus-message 5 mesg) (when (gnus-check-server method) ;; Request that the backend scan its incoming messages. @@ -1708,8 +1712,7 @@ newsgroup." (gnus-active-to-gnus-format method gnus-active-hashtb nil t) ;; We mark this active file as read. (push method gnus-have-read-active-file) - (gnus-message 5 "%sdone" mesg)))))) - (setq methods (cdr methods)))))) + (gnus-message 5 "%sdone" mesg)))))))))) ;; Read an active file and place the results in `gnus-active-hashtb'. (defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors @@ -1786,7 +1789,7 @@ newsgroup." (symbolp group) (set group nil)) (unless ignore-errors - (gnus-message 3 "Warning - illegal active: %s" + (gnus-message 3 "Warning - invalid active: %s" (buffer-substring (gnus-point-at-bol) (gnus-point-at-eol)))))) (widen) @@ -2114,7 +2117,7 @@ If FORCE is non-nil, the .newsrc file is read." (buffer-substring (gnus-point-at-bol) (gnus-point-at-eol)))) nil)) - ;; Skip past ", ". Spaces are illegal in these ranges, but + ;; Skip past ", ". Spaces are invalid in these ranges, but ;; we allow them, because it's a common mistake to put a ;; space after the comma. (skip-chars-forward ", ")) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 12726ec..ac32c3f 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -1416,6 +1416,7 @@ increase the score of each group you read." "o" gnus-article-treat-overstrike "e" gnus-article-emphasize "w" gnus-article-fill-cited-article + "Q" gnus-article-fill-long-lines "c" gnus-article-remove-cr "f" gnus-article-display-x-face "l" gnus-summary-stop-page-breaking @@ -1573,6 +1574,7 @@ increase the score of each group you read." ["Dumb quotes" gnus-article-treat-dumbquotes t] ["Emphasis" gnus-article-emphasize t] ["Word wrap" gnus-article-fill-cited-article t] + ["Fill long lines" gnus-article-fill-long-lines t] ["CR" gnus-article-remove-cr t] ["Show X-Face" gnus-article-display-x-face t] ["UnHTMLize" gnus-article-treat-html t] @@ -1942,8 +1944,6 @@ The following commands are available: (make-local-variable 'gnus-summary-dummy-line-format) (make-local-variable 'gnus-summary-dummy-line-format-spec) (make-local-variable 'gnus-summary-mark-positions) - (make-local-hook 'post-command-hook) - (add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t) (make-local-hook 'pre-command-hook) (add-hook 'pre-command-hook 'gnus-set-global-variables nil t) (gnus-run-hooks 'gnus-summary-mode-hook) @@ -2396,7 +2396,8 @@ marks of articles." (defun gnus-summary-last-article-p (&optional article) "Return whether ARTICLE is the last article in the buffer." (if (not (setq article (or article (gnus-summary-article-number)))) - t ; All non-existent numbers are the last article. :-) + ;; All non-existent numbers are the last article. :-) + t (not (cdr (gnus-data-find-list article))))) (defun gnus-make-thread-indent-array () @@ -4154,7 +4155,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." out)) (defun gnus-adjust-marked-articles (info) - "Set all article lists and remove all marks that are no longer legal." + "Set all article lists and remove all marks that are no longer valid." (let* ((marked-lists (gnus-info-marks info)) (active (gnus-active (gnus-info-group info))) (min (car active)) @@ -4407,7 +4408,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (active (gnus-active group)) ninfo) (when entry - ;; First peel off all illegal article numbers. + ;; First peel off all invalid article numbers. (when active (let ((ids articles) id first) @@ -5682,7 +5683,9 @@ be displayed." ;; The requested article is different from the current article. (prog1 (gnus-summary-display-article article all-headers) - (setq did article)) + (setq did article) + (when (or all-headers gnus-show-all-headers) + (gnus-article-show-all-headers))) (when (or all-headers gnus-show-all-headers) (gnus-article-show-all-headers)) 'old)) @@ -8044,7 +8047,8 @@ returned." The difference between N and the actual number of articles marked is returned." (interactive "p") - (gnus-summary-mark-forward (- n) gnus-del-mark gnus-inhibit-user-auto-expire)) + (gnus-summary-mark-forward + (- n) gnus-del-mark gnus-inhibit-user-auto-expire)) (defun gnus-summary-mark-as-read (&optional article mark) "Mark current article as read. diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index 692b896..ed63e62 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -361,7 +361,8 @@ If TOPIC, start with that topic." ;;; Generating group buffers -(defun gnus-group-prepare-topics (level &optional all lowest regexp list-topic topic-level) +(defun gnus-group-prepare-topics (level &optional all lowest + regexp list-topic topic-level) "List all newsgroups with unread articles of level LEVEL or lower. Use the `gnus-group-topics' to sort the groups. If ALL is non-nil, list groups that have no unread articles. diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index a02cbda..66a209a 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -904,7 +904,7 @@ ARG is passed to the first function." ;;; Various -(defvar gnus-group-buffer) ; Compiler directive +(defvar gnus-group-buffer) ; Compiler directive (defun gnus-alive-p () "Say whether Gnus is running or not." (and (boundp 'gnus-group-buffer) @@ -961,6 +961,21 @@ ARG is passed to the first function." (eq (cadr (memq 'gnus-undeletable (text-properties-at b))) t) (text-property-any b e 'gnus-undeletable t))) +(defun gnus-or (&rest elems) + "Return non-nil if any of the elements are non-nil." + (catch 'found + (while elems + (when (pop elems) + (throw 'found t))))) + +(defun gnus-and (&rest elems) + "Return non-nil if all of the elements are non-nil." + (catch 'found + (while elems + (unless (pop elems) + (throw 'found nil))) + t)) + (provide 'gnus-util) ;;; gnus-util.el ends here diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index 7767663..6ac03e2 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -331,7 +331,8 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (defvar gnus-uu-shar-begin-string "^#! */bin/sh") (defvar gnus-uu-shar-file-name nil) -(defvar gnus-uu-shar-name-marker "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)") +(defvar gnus-uu-shar-name-marker + "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)") (defvar gnus-uu-postscript-begin-string "^%!PS-") (defvar gnus-uu-postscript-end-string "^%%EOF$") diff --git a/lisp/gnus-win.el b/lisp/gnus-win.el index 2860e1a..788e6a7 100644 --- a/lisp/gnus-win.el +++ b/lisp/gnus-win.el @@ -318,7 +318,7 @@ See the Gnus manual for an explanation of the syntax used.") (let ((buffer (cond ((stringp type) type) (t (cdr (assq type gnus-window-to-buffer)))))) (unless buffer - (error "Illegal buffer type: %s" type)) + (error "Invalid buffer type: %s" type)) (switch-to-buffer (gnus-get-buffer-create (gnus-window-to-buffer-helper buffer))) (when (memq 'frame-focus split) @@ -373,7 +373,7 @@ See the Gnus manual for an explanation of the syntax used.") ((integerp size) (setq s size)) (t - (error "Illegal size: %s" size))) + (error "Invalid size: %s" size))) ;; Try to make sure that we are inside the safe limits. (cond ((zerop s)) ((eq type 'horizontal) @@ -500,7 +500,7 @@ should have point." (setq buffer (cond ((stringp type) type) (t (cdr (assq type gnus-window-to-buffer))))) (unless buffer - (error "Illegal buffer type: %s" type)) + (error "Invalid buffer type: %s" type)) (if (and (setq buf (get-buffer (gnus-window-to-buffer-helper buffer))) (setq win (get-buffer-window buf t))) (if (memq 'point split) diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index b73fbb8..bca3843 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -682,7 +682,7 @@ the resulting string may be narrower than END-COLUMN. 'default-toolbar nil) "*If nil, do not use a toolbar. -If it is non-nil, it must be a toolbar. The five legal values are +If it is non-nil, it must be a toolbar. The five valid values are `default-toolbar', `top-toolbar', `bottom-toolbar', `right-toolbar', and `left-toolbar'." :type '(choice (const default-toolbar) diff --git a/lisp/gnus.el b/lisp/gnus.el index 44d4b43..1c2e3e5 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -1,5 +1,5 @@ ;;; gnus.el --- a newsreader for GNU Emacs -;; Copyright (C) 1987,88,89,90,93,94,95,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1987-1990,1993-1999 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -264,12 +264,14 @@ is restarted, and sometimes reloaded." (defconst gnus-product-name "T-gnus" "Product name of this version of gnus.") -(defconst gnus-version-number "6.10.055" +(defconst gnus-version-number "6.10.056" "Version number for this version of gnus.") -(defconst gnus-original-version-number "0.72" +(defconst gnus-original-version-number "0.74" "Version number for this version of Gnus.") +(provide 'running-pterodactyl-gnus-0_73-or-later) + (defconst gnus-original-product-name "Pterodactyl Gnus" "Product name of the original version of Gnus.") @@ -1556,7 +1558,7 @@ If nil, no default charset is assumed when posting." ,(nnheader-concat gnus-cache-directory "active")))) "List of predefined (convenience) servers.") -(defvar gnus-topic-indentation "") ;; Obsolete variable. +(defvar gnus-topic-indentation "");; Obsolete variable. (defconst gnus-article-mark-lists '((marked . tick) (replied . reply) @@ -1799,8 +1801,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") gnus-group-set-mode-line gnus-group-set-info gnus-group-save-newsrc gnus-group-setup-buffer gnus-group-get-new-news gnus-group-make-help-group gnus-group-update-group - gnus-clear-inboxes-moved gnus-group-iterate - gnus-group-group-name) + gnus-group-iterate gnus-group-group-name) ("gnus-bcklg" gnus-backlog-request-article gnus-backlog-enter-article gnus-backlog-remove-article) ("gnus-art" gnus-article-read-summary-keys gnus-article-save @@ -1914,7 +1915,7 @@ such area. The %U (status), %R (replied) and %z (zcore) specs have to be handled with care. For reasons of efficiency, Gnus will compute what column these characters will end up in, and \"hard-code\" that. This means that -it is illegal to have these specs after a variable-length spec. Well, +it is invalid to have these specs after a variable-length spec. Well, you might not be arrested, but your summary buffer will look strange, which is bad enough. @@ -2833,7 +2834,7 @@ If NEWSGROUP is nil, return the global kill file name instead." (defun gnus-read-group (prompt &optional default) "Prompt the user for a group name. -Disallow illegal group names." +Disallow invalid group names." (let ((prefix "") group) (while (not group) @@ -2842,7 +2843,7 @@ Disallow illegal group names." (setq group (read-string (concat prefix prompt) (cons (or default "") 0) 'gnus-group-history))) - (setq prefix (format "Illegal group name: \"%s\". " group) + (setq prefix (format "Invalid group name: \"%s\". " group) group nil))) group)) diff --git a/lisp/mail-source.el b/lisp/mail-source.el index f7d1b83..ccd33c0 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -73,6 +73,9 @@ The default is nil." ;;; Internal variables. +(defvar mail-source-string "" + "A dynamically bound string that says what the current mail source is.") + (eval-and-compile (defvar mail-source-keyword-map '((file @@ -80,8 +83,7 @@ The default is nil." (concat "/usr/spool/mail/" (user-login-name))))) (directory (:path) - (:suffix ".spool") - (:match)) + (:suffix ".spool")) (pop (:server (getenv "MAILHOST")) (:port "pop3") @@ -108,7 +110,7 @@ All keywords that can be used must be listed here.")) "Strip the leading colon off the KEYWORD." (intern (substring (symbol-name keyword) 1)))) -(eval-when-compile +(eval-and-compile (defun mail-source-bind-1 (type) (let* ((defaults (cdr (assq type mail-source-keyword-map))) default bind) @@ -118,14 +120,20 @@ All keywords that can be used must be listed here.")) bind)) bind))) -(defmacro mail-source-bind (type source &rest body) - "Bind all variables in SOURCE." - `(let ,(mail-source-bind-1 type) - (mail-source-set-1 source) +(defmacro mail-source-bind (type-source &rest body) + "Return a `let' form that binds all variables in source TYPE. +At run time, the mail source specifier SOURCE will be inspected, +and the variables will be set according to it. Variables not +specified will be given default values. + +After this is done, BODY will be executed in the scope +of the `let' form." + `(let ,(mail-source-bind-1 (car type-source)) + (mail-source-set-1 ,(cadr type-source)) ,@body)) -(put 'mail-source-bind 'lisp-indent-function 2) -(put 'mail-source-bind 'edebug-form-spec '(form form body)) +(put 'mail-source-bind 'lisp-indent-function 1) +(put 'mail-source-bind 'edebug-form-spec '(form body)) (defun mail-source-set-1 (source) (let* ((type (pop source)) @@ -185,11 +193,13 @@ Pass INFO on to CALLBACK." (if (or (not (file-exists-p mail-source-crash-box)) (zerop (nth 7 (file-attributes mail-source-crash-box)))) (progn - (delete-file mail-source-crash-box) + (when (file-exists-p mail-source-crash-box) + (delete-file mail-source-crash-box)) 0) (funcall callback mail-source-crash-box info) (if mail-source-delete-incoming - (delete-file mail-source-crash-box) + (when (file-exists-p mail-source-crash-box) + (delete-file mail-source-crash-box)) (let ((incoming (mail-source-make-complex-temp-name (expand-file-name @@ -216,6 +226,9 @@ Pass INFO on to CALLBACK." ((not (file-exists-p from)) ;; There is no inbox. (setq to nil)) + ((zerop (nth 7 (file-attributes from))) + ;; Empty file. + (setq to nil)) (t ;; If getting from mail spool directory, use movemail to move ;; rather than just renaming, so as to interlock with the @@ -270,7 +283,8 @@ Pass INFO on to CALLBACK." (buffer-string) result)) (error "%s" (buffer-string))) (setq to nil))))))) - (when (buffer-name errors) + (when (and errors + (buffer-name errors)) (kill-buffer errors)) ;; Return whether we moved successfully or not. to))) @@ -284,7 +298,7 @@ If ARGS, PROMPT is used as an argument to `format'." (apply 'format prompt args) prompt))) (unless mail-source-read-passwd - (if (load "passwd" t) + (if (or (fboundp 'read-passwd) (load "passwd" t)) (setq mail-source-read-passwd 'read-passwd) (unless (fboundp 'ange-ftp-read-passwd) (autoload 'ange-ftp-read-passwd "ange-ftp")) @@ -293,18 +307,20 @@ If ARGS, PROMPT is used as an argument to `format'." (defun mail-source-fetch-file (source callback) "Fetcher for single-file sources." - (mail-source-bind file source - (if (mail-source-movemail path mail-source-crash-box) - (mail-source-callback callback path) - 0))) + (mail-source-bind (file source) + (let ((mail-source-string (format "file:%s" path))) + (if (mail-source-movemail path mail-source-crash-box) + (mail-source-callback callback path) + 0)))) (defun mail-source-fetch-directory (source callback) "Fetcher for directory sources." - (mail-source-bind directory source + (mail-source-bind (directory source) (let ((files (directory-files path t - (or match (concat (regexp-quote suffix) "$")))) + (concat (regexp-quote suffix) "$"))) (found 0) + (mail-source-string (format "directory:%s" path)) file) (while (setq file (pop files)) (when (mail-source-movemail file mail-source-crash-box) @@ -313,8 +329,9 @@ If ARGS, PROMPT is used as an argument to `format'." (defun mail-source-fetch-pop (source callback) "Fetcher for single-file sources." - (mail-source-bind pop source - (let ((from (format "%s:%s:%s" server user port))) + (mail-source-bind (pop source) + (let ((from (format "%s:%s:%s" server user port)) + (mail-source-string (format "pop:%s@%s" user server))) (setq password (or password (cdr (assoc from mail-source-password-cache)) @@ -325,7 +342,7 @@ If ARGS, PROMPT is used as an argument to `format'." (let ((pop3-password password) (pop3-maildrop user) (pop3-mailhost server)) - (if (pop3-movemail mail-source-crash-box) + (if (save-current-buffer (pop3-movemail mail-source-crash-box)) (mail-source-callback callback server) ;; We nix out the password in case the error ;; was because of a wrong password being given. diff --git a/lisp/message.el b/lisp/message.el index 6516ddf..eb6be87 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -433,7 +433,7 @@ The provided functions are: The headers should be delimited by a line whose contents match the variable `mail-header-separator'. -Legal values include `message-send-mail-with-sendmail' (the default), +Valid values include `message-send-mail-with-sendmail' (the default), `message-send-mail-with-mh', `message-send-mail-with-qmail' and `message-send-mail-with-smtp'." :type '(radio (function-item message-send-mail-with-sendmail) @@ -1522,6 +1522,7 @@ Point is left at the beginning of the narrowed-to region." ["Newline and Reformat" message-newline-and-reformat t] ["Rename buffer" message-rename-buffer t] ["Spellcheck" ispell-message t] + ["Attach file as MIME" message-mime-attach-file t] "----" ["Send Message" message-send-and-exit t] ["Abort Message" message-dont-send t] @@ -1574,7 +1575,8 @@ 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)." +C-c C-r message-caesar-buffer-body (rot13 the message body). +C-c C-a message-mime-attach-file (attach a file as MIME)." (interactive) (kill-all-local-variables) (set (make-local-variable 'message-reply-buffer) nil) @@ -2127,7 +2129,7 @@ be added to \"References\" field." (insert "\n")) (funcall message-citation-line-function)))) -(defvar mail-citation-hook) ;Compiler directive +(defvar mail-citation-hook) ;Compiler directive (defun message-cite-original () "Cite function in the standard Message manner." (if (and (boundp 'mail-citation-hook) @@ -2387,7 +2389,8 @@ the user from the mailer." (message-check 'invisible-text (when (text-property-any (point-min) (point-max) 'invisible t) (put-text-property (point-min) (point-max) 'invisible nil) - (unless (yes-or-no-p "Invisible text found and made visible; continue posting? ") + (unless (yes-or-no-p + "Invisible text found and made visible; continue posting? ") (error "Invisible text found and made visible"))))) (defun message-add-action (action &rest types) @@ -2741,12 +2744,6 @@ This sub function is for exclusive use of `message-send-news'." (replace-match "\n") (backward-char 1) (run-hooks 'message-send-news-hook) - ;;(require (car method)) - ;;(funcall (intern (format "%s-open-server" (car method))) - ;;(cadr method) (cddr method)) - ;;(setq result - ;; (funcall (intern (format "%s-request-post" (car method))) - ;; (cadr method))) (gnus-open-server method) (gnus-request-post method) )) @@ -4454,7 +4451,9 @@ Optional NEWS will use news to forward instead of mail." (let ((cur (current-buffer)) (subject (message-make-forward-subject)) art-beg) - (if news (message-news nil subject) (message-mail nil subject)) + (if news + (message-news nil subject) + (message-mail nil subject)) ;; Put point where we want it before inserting the forwarded ;; message. (if message-signature-before-forwarded-message @@ -4897,8 +4896,9 @@ description of the attachment." (description (message-mime-query-description))) (list file type description))) (insert (format - "<#part type=%s filename=%s%s disposition=attachment><#/part>\n" - type (prin1-to-string file) + "<#part type=%s name=%s filename=%s%s disposition=attachment><#/part>\n" + type (prin1-to-string (file-name-nondirectory file)) + (prin1-to-string file) (if description (format " description=%s" (prin1-to-string description)) "")))) diff --git a/lisp/messagexmas.el b/lisp/messagexmas.el index 7274468..b817f86 100644 --- a/lisp/messagexmas.el +++ b/lisp/messagexmas.el @@ -39,7 +39,7 @@ automatically.") 'default-toolbar nil) "*If nil, do not use a toolbar. -If it is non-nil, it must be a toolbar. The five legal values are +If it is non-nil, it must be a toolbar. The five valid values are `default-toolbar', `top-toolbar', `bottom-toolbar', `right-toolbar', and `left-toolbar'.") diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index 0403bb6..b41d5de 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -69,8 +69,7 @@ If no encoding was done, nil is returned." charsets) ;; We encode. (t - (let ((mime-charset - (mm-mime-charset (car charsets) (point-min) (point-max))) + (let ((mime-charset (mm-mime-charset (car charsets))) start) (when (or t ;; We always decode. diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index a034058..7b39e98 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -81,6 +81,7 @@ ("text/enriched" mm-inline-text t) ("text/richtext" mm-inline-text t) ("text/html" mm-inline-text (locate-library "w3")) + ("text/x-vcard" mm-inline-text (locate-library "vcard")) ("message/delivery-status" mm-inline-text t) ("text/.*" mm-inline-text t) ("audio/wav" mm-inline-audio @@ -101,7 +102,11 @@ (defvar mm-user-automatic-display '("text/plain" "text/enriched" "text/richtext" "text/html" - "image/.*" "message/delivery-status" "multipart/.*")) + "text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*")) + +(defvar mm-attachment-override-types + '("text/plain" "text/x-vcard") + "Types that should have \"attachment\" ignored if they can be displayed inline.") (defvar mm-user-automatic-external-display nil "List of MIME type regexps that will be displayed externally automatically.") @@ -430,6 +435,16 @@ external if displayed external." methods nil))) result)) +(defun mm-attachment-override-p (type) + "Say whether TYPE should have attachment behavior overridden." + (let ((types mm-attachment-override-types) + ty) + (catch 'found + (while (setq ty (pop types)) + (when (and (string-match ty type) + (mm-inlinable-p type)) + (throw 'found t)))))) + (defun mm-automatic-external-display-p (type) "Return the user-defined method for TYPE." (let ((methods mm-user-automatic-external-display) diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 7f99bd2..80f1989 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -189,14 +189,19 @@ used as the line break code type of the coding system." (when (fboundp 'set-buffer-multibyte) (set-buffer-multibyte nil))) -(defun mm-mime-charset (charset b e) +(defun mm-mime-charset (charset) + "Return the MIME charset corresponding to the MULE CHARSET." (if (fboundp 'coding-system-get) + ;; This exists in Emacs 20. (or - (coding-system-get - (get-charset-property charset 'prefered-coding-system) - 'mime-charset) - (car (memq charset (find-coding-systems-region - (point-min) (point-max))))) + (and (get-charset-property charset 'prefered-coding-system) + (coding-system-get + (get-charset-property charset 'prefered-coding-system) + 'mime-charset)) + (and (eq charset 'ascii) + 'us-ascii) + (get-charset-property charset 'prefered-coding-system)) + ;; This is for XEmacs. (mm-mule-charset-to-mime-charset charset))) (defsubst mm-multibyte-p () @@ -261,11 +266,12 @@ See also `with-temp-file' and `with-output-to-string'." (defun mm-read-charset (prompt) "Return a charset." - (completing-read - prompt - (mapcar (lambda (e) (list (symbol-name (car e)))) - mm-mime-mule-charset-alist) - nil t)) + (intern + (completing-read + prompt + (mapcar (lambda (e) (list (symbol-name (car e)))) + mm-mime-mule-charset-alist) + nil t))) (provide 'mm-util) diff --git a/lisp/mm-uu.el b/lisp/mm-uu.el index edc6361..6556af5 100644 --- a/lisp/mm-uu.el +++ b/lisp/mm-uu.el @@ -2,7 +2,7 @@ ;; Copyright (c) 1998 by Shenghuo Zhu ;; Author: Shenghuo Zhu -;; $Revision: 1.1.2.9 $ +;; $Revision: 1.1.2.10 $ ;; Keywords: news postscript uudecode binhex shar ;; This file is not part of GNU Emacs, but the same permissions @@ -141,7 +141,8 @@ This can be either \"inline\" or \"attachment\".") "application/octet-stream")) 'x-uuencode nil (if (and file-name (not (equal file-name ""))) - (list mm-dissect-disposition (cons 'filename file-name))))) + (list mm-dissect-disposition + (cons 'filename file-name))))) ((eq type 'binhex) (mm-make-handle (mm-uu-copy-to-buffer start-char end-char) (list (or (and file-name @@ -151,7 +152,8 @@ This can be either \"inline\" or \"attachment\".") "application/octet-stream")) 'x-binhex nil (if (and file-name (not (equal file-name ""))) - (list mm-dissect-disposition (cons 'filename file-name))))) + (list mm-dissect-disposition + (cons 'filename file-name))))) ((eq type 'shar) (mm-make-handle (mm-uu-copy-to-buffer start-char end-char) '("application/x-shar")))) diff --git a/lisp/mm-view.el b/lisp/mm-view.el index c7cc4dc..a693aaa 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -28,6 +28,11 @@ (require 'mm-bodies) (require 'mm-decode) +(eval-and-compile + (autoload 'gnus-article-prepare-display "gnus-art") + (autoload 'vcard-parse-string "vcard") + (autoload 'vcard-format-string "vcard")) + ;;; ;;; Functions for displaying various formats inline ;;; @@ -86,6 +91,13 @@ (enriched-decode (point-min) (point-max)) (setq text (buffer-string))))) (mm-insert-inline handle text)) + ((equal type "x-vcard") + (mm-insert-inline + handle + (concat "\n-- \n" + (vcard-format-string + (vcard-parse-string (mm-get-part handle) + 'vcard-standard-filter))))) (t (setq text (mm-get-part handle)) (let ((b (point)) @@ -123,9 +135,6 @@ (require 'w3) (w3-prepare-buffer)) -(eval-and-compile - (autoload 'gnus-article-prepare-display "gnus-art")) - (defun mm-view-message () (gnus-article-prepare-display) (run-hooks 'gnus-article-decode-hook) diff --git a/lisp/nnbabyl.el b/lisp/nnbabyl.el index 0d71532..f26fe4f 100644 --- a/lisp/nnbabyl.el +++ b/lisp/nnbabyl.el @@ -32,7 +32,8 @@ (require 'nnheader) (condition-case nil (require 'rmail) - (t (nnheader-message 5 "Ignore rmail errors from this file, you don't have rmail"))) + (t (nnheader-message + 5 "Ignore rmail errors from this file, you don't have rmail"))) (require 'nnmail) (require 'nnoo) (eval-when-compile (require 'cl)) diff --git a/lisp/nndoc.el b/lisp/nndoc.el index 907edca..ad3c8f6 100644 --- a/lisp/nndoc.el +++ b/lisp/nndoc.el @@ -684,7 +684,8 @@ PARENT is the message-ID of the parent summary line, or nil for none." (goto-char head-begin) (setq content-type (message-fetch-field "Content-Type")) (when content-type - (when (string-match "^ *\\([^ \t\n/;]+\\)/\\([^ \t\n/;]+\\)" content-type) + (when (string-match + "^ *\\([^ \t\n/;]+\\)/\\([^ \t\n/;]+\\)" content-type) (setq type (downcase (match-string 1 content-type)) subtype (downcase (match-string 2 content-type)) message-rfc822 (and (string= type "message") diff --git a/lisp/nneething.el b/lisp/nneething.el index e885df6..2c6fb78 100644 --- a/lisp/nneething.el +++ b/lisp/nneething.el @@ -127,7 +127,8 @@ included.") (nnmail-find-file file) ; Insert the file in the nntp buf. (unless (nnheader-article-p) ; Either it's a real article... (goto-char (point-min)) - (nneething-make-head file (current-buffer)) ; ... or we fake some headers. + (nneething-make-head + file (current-buffer)) ; ... or we fake some headers. (insert "\n")) t)))) @@ -315,7 +316,8 @@ included.") (substring file (match-beginning 1) (match-end 1)) - (when (string-match "/\\(users\\|home\\)/\\([^/]+\\)/" file) + (when (string-match + "/\\(users\\|home\\)/\\([^/]+\\)/" file) (setq login (substring file (match-beginning 2) (match-end 2)) diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el index d562c39..ce32e93 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -517,7 +517,8 @@ deleted. Point is left where the deleted region was." (save-restriction (narrow-to-region (save-excursion - (forward-line 1) ; in case point is at beginning of message already + ;; In case point is at the beginning of the message already. + (forward-line 1) (nnmail-search-unix-mail-delim-backward) (if leave-delim (progn (forward-line 1) (point)) (point))) diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 0172cae..aa3d6bd 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -1,5 +1,5 @@ ;;; nnheader.el --- header access macros for Semi-gnus and its backends -;; Copyright (C) 198,997,88,89,90,93,94,95,96,97,98 Free Software Foundation, Inc. +;; Copyright (C) 1987-1990,1993-1999 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -52,7 +52,7 @@ (defvar nnheader-file-name-translation-alist nil "*Alist that says how to translate characters in file names. -For instance, if \":\" is illegal as a file character in file names +For instance, if \":\" is invalid as a file character in file names on your system, you could say something like: \(setq nnheader-file-name-translation-alist '((?: . ?_)))") @@ -497,7 +497,8 @@ the line could be found." (defun nnheader-insert-references (references message-id) "Insert a References header based on REFERENCES and MESSAGE-ID." (if (and (not references) (not message-id)) - () ; This is illegal, but not all articles have Message-IDs. + ;; This is invalid, but not all articles have Message-IDs. + () (mail-position-on-field "References") (let ((begin (save-excursion (beginning-of-line) (point))) (fill-column 78) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index e402773..f80559c 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -31,6 +31,7 @@ (require 'message) (require 'custom) (require 'gnus-util) +(require 'mail-source) (eval-and-compile (autoload 'gnus-error "gnus-util") @@ -169,43 +170,12 @@ Eg.: :group 'nnmail :type 'boolean) -(defcustom nnmail-spool-file - (or (getenv "MAIL") - (concat "/usr/spool/mail/" (user-login-name))) +(defcustom nnmail-spool-file '((file)) "*Where the mail backends will look for incoming mail. -This variable is \"/usr/spool/mail/$user\" by default. -If this variable is nil, no mail backends will read incoming mail. -If this variable is a list, all files mentioned in this list will be -used as incoming mailboxes. -If this variable is a directory (i. e., it's name ends with a \"/\"), -treat all files in that directory as incoming spool files." +This variable is a list of mail source specifiers. +If this variable is nil, no mail backends will read incoming mail." :group 'nnmail-files - :type '(choice (file :tag "File") - (repeat :tag "Files" file))) - -(defcustom nnmail-crash-box "~/.gnus-crash-box" - "File where Gnus will store mail while processing it." - :group 'nnmail-files - :type 'file) - -(defcustom nnmail-use-procmail nil - "*If non-nil, the mail backends will look in `nnmail-procmail-directory' for spool files. -The file(s) in `nnmail-spool-file' will also be read." - :group 'nnmail-procmail - :type 'boolean) - -(defcustom nnmail-procmail-directory "~/incoming/" - "*When using procmail (and the like), incoming mail is put in this directory. -The Gnus mail backends will read the mail from this directory." - :group 'nnmail-procmail - :type 'directory) - -(defcustom nnmail-procmail-suffix "\\.spool" - "*Suffix of files created by procmail (and the like). -This variable might be a suffix-regexp to match the suffixes of -several files - eg. \".spool[0-9]*\"." - :group 'nnmail-procmail - :type 'regexp) + :type 'sexp) (defcustom nnmail-resplit-incoming nil "*If non-nil, re-split incoming procmail sorted mail." @@ -230,29 +200,6 @@ links, you could set this variable to `copy-file' instead." (function-item copy-file) (function :tag "Other"))) -(defcustom nnmail-movemail-program "movemail" - "*A command to be executed to move mail from the inbox. -The default is \"movemail\". - -This can also be a function. In that case, the function will be -called with two parameters -- the name of the INBOX file, and the file -to be moved to." - :group 'nnmail-files - :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 - :type 'boolean) - (defcustom nnmail-read-incoming-hook (if (eq system-type 'windows-nt) '(nnheader-ms-strip-cr) @@ -285,7 +232,6 @@ If you use `display-time', you could use something like this: :group 'nnmail-prepare :type 'hook) -;; Suggested by Erik Selberg . (defcustom nnmail-prepare-incoming-hook nil "Hook called before treating incoming mail. The hook is run in a buffer with all the new, incoming mail." @@ -330,15 +276,6 @@ discarded after running the split process." :group 'nnmail-split :type 'hook) -;; Suggested by Mejia Pablo J . -(defcustom nnmail-tmp-directory nil - "*If non-nil, use this directory for temporary storage. -Used when reading incoming mail." - :group 'nnmail-files - :group 'nnmail-retrieve - :type '(choice (const :tag "default" nil) - (directory :format "%v"))) - (defcustom nnmail-large-newsgroup 50 "*The number of the articles which indicates a large newsgroup. If the number of the articles is greater than the value, verbose @@ -414,12 +351,6 @@ Example: :group 'nnmail-split :type '(repeat (cons :format "%v" symbol regexp))) -(defcustom nnmail-delete-incoming nil - "*If non-nil, the mail backends will delete incoming files after -splitting." - :group 'nnmail-retrieve - :type 'boolean) - (defcustom nnmail-message-id-cache-length 1000 "*The approximate number of Message-IDs nnmail will keep in its cache. If this variable is nil, no checking on duplicate messages will be @@ -436,7 +367,7 @@ performed." (defcustom nnmail-treat-duplicates 'warn "*If non-nil, nnmail keep a cache of Message-IDs to discover mail duplicates. -Three values are legal: nil, which means that nnmail is not to keep a +Three values are valid: nil, which means that nnmail is not to keep a Message-ID cache; `warn', which means that nnmail should insert extra headers to warn the user about the duplication (this is the default); and `delete', which means that nnmail will delete duplicated mails. @@ -466,9 +397,6 @@ parameter. It should return nil, `warn' or `delete'." (defvar nnmail-current-spool nil) -(defvar nnmail-pop-password nil - "*Password to use when reading mail from a POP server, if required.") - (defvar nnmail-split-fancy-syntax-table nil "Syntax table used by `nnmail-split-fancy'.") (unless (syntax-table-p nnmail-split-fancy-syntax-table) @@ -480,11 +408,6 @@ parameter. It should return nil, `warn' or `delete'." (defvar nnmail-prepare-save-mail-hook nil "Hook called before saving mail.") -(defvar nnmail-moved-inboxes nil - "List of inboxes that have been moved.") - -(defvar nnmail-internal-password nil) - (defvar nnmail-split-tracing nil) (defvar nnmail-split-trace nil) @@ -543,127 +466,6 @@ parameter. It should return nil, `warn' or `delete'." "/"))) (or file ""))) -;; Function rewritten from rmail.el. -(defun nnmail-move-inbox (inbox) - "Move INBOX to `nnmail-crash-box'." - (if (not (file-writable-p nnmail-crash-box)) - (gnus-error 1 "Can't write to crash box %s. Not moving mail" - nnmail-crash-box) - ;; If the crash box exists and is empty, we delete it. - (when (and (file-exists-p nnmail-crash-box) - (zerop (nnheader-file-size (file-truename nnmail-crash-box)))) - (delete-file nnmail-crash-box)) - (let ((tofile (file-truename (expand-file-name nnmail-crash-box))) - (popmail (string-match "^po:" inbox)) - movemail errors result) - (unless popmail - (setq inbox (file-truename (expand-file-name inbox))) - (setq movemail t) - ;; On some systems, /usr/spool/mail/foo is a directory - ;; and the actual inbox is /usr/spool/mail/foo/foo. - (when (file-directory-p inbox) - (setq inbox (expand-file-name (user-login-name) inbox)))) - (if (member inbox nnmail-moved-inboxes) - ;; We don't try to move an already moved inbox. - nil - (if popmail - (progn - (when (and nnmail-pop-password - (not nnmail-internal-password)) - (setq nnmail-internal-password nnmail-pop-password)) - (when (and nnmail-pop-password-required - (not nnmail-internal-password)) - (setq nnmail-internal-password - (nnmail-read-passwd - (format "Password for %s: " - (substring inbox (+ popmail 3)))))) - (nnheader-message 5 "Getting mail from the post office...")) - (when (or (and (file-exists-p tofile) - (/= 0 (nnheader-file-size tofile))) - (and (file-exists-p inbox) - (/= 0 (nnheader-file-size inbox)))) - (nnheader-message 5 "Getting mail from %s..." inbox))) - ;; Set TOFILE if have not already done so, and - ;; rename or copy the file INBOX to TOFILE if and as appropriate. - (cond - ((file-exists-p tofile) - ;; The crash box exists already. - t) - ((and (not popmail) - (not (file-exists-p inbox))) - ;; There is no inbox. - (setq tofile nil)) - (t - ;; If getting from mail spool directory, use movemail to move - ;; rather than just renaming, so as to interlock with the - ;; mailer. - (unwind-protect - (save-excursion - (setq errors (generate-new-buffer " *nnmail loss*")) - (buffer-disable-undo errors) - (if (nnheader-functionp nnmail-movemail-program) - (condition-case err - (progn - (funcall nnmail-movemail-program inbox tofile) - (setq result 0)) - (error - (save-excursion - (set-buffer errors) - (insert (prin1-to-string err)) - (setq result 255)))) - (let ((default-directory "/")) - (setq result - (apply - 'call-process - (append - (list - (expand-file-name - 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)) - ;; No output => movemail won - (progn - (unless popmail - (when (file-exists-p tofile) - (set-file-modes tofile nnmail-default-file-modes)))) - (set-buffer errors) - ;; There may be a warning about older revisions. We - ;; ignore those. - (goto-char (point-min)) - (if (search-forward "older revision" nil t) - (progn - (unless popmail - (when (file-exists-p tofile) - (set-file-modes - tofile nnmail-default-file-modes)))) - ;; Probably a real error. - ;; We nix out the password in case the error - ;; was because of a wrong password being given. - (setq nnmail-internal-password nil) - (subst-char-in-region (point-min) (point-max) ?\n ?\ ) - (goto-char (point-max)) - (skip-chars-backward " \t") - (delete-region (point) (point-max)) - (goto-char (point-min)) - (when (looking-at "movemail: ") - (delete-region (point-min) (match-end 0))) - (unless (yes-or-no-p - (format "movemail: %s (%d return). Continue? " - (buffer-string) result)) - (error "%s" (buffer-string))) - (setq tofile nil))))))) - (nnheader-message 5 "Getting mail from %s...done" inbox) - (and errors - (buffer-name errors) - (kill-buffer errors)) - tofile)))) - (defun nnmail-get-active () "Returns an assoc of group names and active ranges. nn*-request-list should have been called before calling this function." @@ -699,31 +501,16 @@ nn*-request-list should have been called before calling this function." (insert (format "%s %d %d y\n" (car group) (cdadr group) (caadr group)))))) -(defun nnmail-get-split-group (file group) +(defun nnmail-get-split-group (file source) "Find out whether this FILE is to be split into GROUP only. -If GROUP is non-nil and we are using procmail, return the group name -only when the file is the correct procmail file. When GROUP is nil, -return nil if FILE is a spool file or the procmail group for which it -is a spool. If not using procmail, return GROUP." - (if (or (eq nnmail-spool-file 'procmail) - nnmail-use-procmail) - (if (string-match (concat "^" (regexp-quote - (expand-file-name - (file-name-as-directory - nnmail-procmail-directory))) - "\\([^/]*\\)" - nnmail-procmail-suffix "$") - (expand-file-name file)) - (let ((procmail-group (substring (expand-file-name file) - (match-beginning 1) - (match-end 1)))) - (if group - (if (string-equal group procmail-group) - group - nil) - procmail-group)) - nil) - group)) +If SOURCE is a directory spec, try to return the group name component." + (if (eq (car source) 'directory) + (let ((file (file-name-nondirectory file))) + (mail-source-bind (directory source) + (if (string-match (concat (regexp-quote suffix) "$") file) + (substring file 0 (match-beginning 0)) + nil))) + nil)) (defun nnmail-process-babyl-mail-format (func artnum-func) (let ((case-fold-search t) @@ -1005,8 +792,6 @@ FUNC will be called with the buffer narrowed to each mail." (let (;; If this is a group-specific split, we bind the split ;; methods to just this group. (nnmail-split-methods (if (and group - (or (eq nnmail-spool-file 'procmail) - nnmail-use-procmail) (not nnmail-resplit-incoming)) (list (list group "")) nnmail-split-methods))) @@ -1216,16 +1001,6 @@ Return the number of characters in the body." ;;; Utility functions -(defun nnmail-make-complex-temp-name (prefix) - (let ((newname (make-temp-name prefix)) - (newprefix prefix)) - (while (file-exists-p newname) - (setq newprefix (concat newprefix "x")) - (setq newname (make-temp-name newprefix))) - newname)) - -;; Written by Per Abrahamsen . - (defun nnmail-split-fancy () "Fancy splitting method. See the documentation for the variable `nnmail-split-fancy' for documentation." @@ -1356,68 +1131,6 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (apply 'concat (nreverse expanded)) newtext))) -;; Get a list of spool files to read. -(defun nnmail-get-spool-files (&optional group) - (if (null nnmail-spool-file) - ;; No spool file whatsoever. - nil - (let* ((procmails - ;; If procmail is used to get incoming mail, the files - ;; are stored in this directory. - (and (file-exists-p nnmail-procmail-directory) - (or (eq nnmail-spool-file 'procmail) - nnmail-use-procmail) - (directory-files - nnmail-procmail-directory - t (concat (if group (concat "^" (regexp-quote group)) "") - nnmail-procmail-suffix "$")))) - (p procmails) - (crash (when (and (file-exists-p nnmail-crash-box) - (> (nnheader-file-size - (file-truename nnmail-crash-box)) - 0)) - (list nnmail-crash-box)))) - ;; Remove any directories that inadvertently match the procmail - ;; suffix, which might happen if the suffix is "". - (while p - (when (file-directory-p (car p)) - (setq procmails (delete (car p) procmails))) - (setq p (cdr p))) - ;; Return the list of spools. - (append - crash - (cond ((and group - (or (eq nnmail-spool-file 'procmail) - nnmail-use-procmail) - procmails) - procmails) - ((and group - (eq nnmail-spool-file 'procmail)) - nil) - ((listp nnmail-spool-file) - (nconc - (apply - 'nconc - (mapcar - (lambda (file) - (if (and (not (string-match "^po:" file)) - (file-directory-p file)) - (nnheader-directory-regular-files file) - (list file))) - nnmail-spool-file)) - procmails)) - ((stringp nnmail-spool-file) - (if (and (not (string-match "^po:" nnmail-spool-file)) - (file-directory-p nnmail-spool-file)) - (nconc - (nnheader-directory-regular-files nnmail-spool-file) - procmails) - (cons nnmail-spool-file procmails))) - ((eq nnmail-spool-file 'pop) - (cons (format "po:%s" (user-login-name)) procmails)) - (t - procmails)))))) - ;; Activate a backend only if it isn't already activated. ;; If FORCE, re-read the active file even if the backend is ;; already activated. @@ -1531,6 +1244,13 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (t nnmail-treat-duplicates)))) group-art) + ;; We insert a line that says what the mail source is. + (let ((case-fold-search t)) + (goto-char (point-min)) + (re-search-forward "^message-id[ \t]*:" nil t) + (beginning-of-line) + (insert (format "X-Gnus-Mail-Source: %s\n" mail-source-string))) + ;; Let the backend save the article (or not). (cond ((not duplication) @@ -1567,9 +1287,11 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (defun nnmail-get-new-mail (method exit-func temp &optional group spool-func) "Read new incoming mail." - (let* ((spools (nnmail-get-spool-files group)) + (let* ((sources (if (listp nnmail-spool-file) nnmail-spool-file + (list nnmail-spool-file))) (group-in group) - nnmail-current-spool incoming incomings spool) + (i 0) + nnmail-current-spool incoming incomings source) (when (and (nnmail-get-value "%s-get-new-mail" method) nnmail-spool-file) ;; We first activate all the groups. @@ -1578,61 +1300,42 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (run-hooks 'nnmail-pre-get-new-mail-hook) ;; Open the message-id cache. (nnmail-cache-open) - ;; The we go through all the existing spool files and split the - ;; mail from each. - (while spools - (setq spool (pop spools)) - ;; We read each spool file if either the spool is a POP-mail - ;; spool, or the file exists. We can't check for the - ;; existence of POPped mail. - (when (or (string-match "^po:" spool) - (and (file-exists-p (file-truename spool)) - (> (nnheader-file-size (file-truename spool)) 0))) - (nnheader-message 3 "%s: Reading incoming mail..." method) - (when (and (nnmail-move-inbox spool) - (file-exists-p nnmail-crash-box)) - (setq nnmail-current-spool spool) - ;; There is new mail. We first find out if all this mail - ;; is supposed to go to some specific group. - (setq group (nnmail-get-split-group spool group-in)) - ;; We split the mail - (nnmail-split-incoming - nnmail-crash-box (intern (format "%s-save-mail" method)) - spool-func group (intern (format "%s-active-number" method))) - ;; Check whether the inbox is to be moved to the special tmp dir. - (setq incoming - (nnmail-make-complex-temp-name - (expand-file-name - (if nnmail-tmp-directory - (concat - (file-name-as-directory nnmail-tmp-directory) - (file-name-nondirectory - (concat (file-name-as-directory temp) "Incoming"))) - (concat (file-name-as-directory temp) "Incoming"))))) - (unless (file-exists-p (file-name-directory incoming)) - (make-directory (file-name-directory incoming) t)) - (rename-file nnmail-crash-box incoming t) - (push incoming incomings)))) + ;; The we go through all the existing mail source specification + ;; and fetch the mail from each. + (while (setq source (pop sources)) + ;; Be compatible with old values. + (when (stringp source) + (setq source + (cond + ((string-match "^po:" source) + (list 'pop :user (substring source (match-end 0)))) + ((file-directory-p source) + (list 'directory :path source)) + (t + (list 'file :path source))))) + (nnheader-message 4 "%s: Reading incoming mail from %s..." + method (car source)) + (when (mail-source-fetch + source + `(lambda (file orig-file) + (nnmail-split-incoming + file ',(intern (format "%s-save-mail" method)) + ',spool-func (nnmail-get-split-group orig-file source) + ',(intern (format "%s-active-number" method))))) + (incf i))) ;; If we did indeed read any incoming spools, we save all info. - (when incomings + (unless (zerop i) (nnmail-save-active (nnmail-get-value "%s-group-alist" method) (nnmail-get-value "%s-active-file" method)) (when exit-func (funcall exit-func)) (run-hooks 'nnmail-read-incoming-hook) - (nnheader-message 3 "%s: Reading incoming mail...done" method)) + (nnheader-message 4 "%s: Reading incoming mail...done" method)) ;; Close the message-id cache. (nnmail-cache-close) ;; Allow the user to hook. - (run-hooks 'nnmail-post-get-new-mail-hook) - ;; Delete all the temporary files. - (while incomings - (setq incoming (pop incomings)) - (and nnmail-delete-incoming - (file-exists-p incoming) - (file-writable-p incoming) - (delete-file incoming)))))) + (run-hooks 'nnmail-post-get-new-mail-hook)))) (defun nnmail-expired-article-p (group time force &optional inhibit) "Say whether an article that is TIME old in GROUP should be expired." @@ -1659,24 +1362,6 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (time-less-p days (time-since time)) (error nil))))))) -(defvar nnmail-read-passwd nil) -(defun nnmail-read-passwd (prompt &rest args) - "Read a password using PROMPT. -If ARGS, PROMPT is used as an argument to `format'." - (let ((prompt - (if args - (apply 'format prompt args) - prompt))) - (unless nnmail-read-passwd - (if (functionp 'read-passwd) - (setq nnmail-read-passwd 'read-passwd) - (if (load "passwd" t) - (setq nnmail-read-passwd 'read-passwd) - (unless (fboundp 'ange-ftp-read-passwd) - (autoload 'ange-ftp-read-passwd "ange-ftp")) - (setq nnmail-read-passwd 'ange-ftp-read-passwd)))) - (funcall nnmail-read-passwd prompt))) - (defun nnmail-check-syntax () "Check (and modify) the syntax of the message in the current buffer." (save-restriction @@ -1785,19 +1470,6 @@ If ARGS, PROMPT is used as an argument to `format'." his nil))) found)) -(eval-and-compile - (autoload 'pop3-movemail "pop3")) - -(defun nnmail-pop3-movemail (inbox crashbox) - "Function to move mail from INBOX on a pop3 server to file CRASHBOX." - (let ((pop3-maildrop - (substring inbox (match-end (string-match "^po:" inbox)))) - (pop3-password - (or nnmail-pop-password - (nnmail-read-passwd - (format "Password for %s: " inbox))))) - (pop3-movemail crashbox))) - (defun nnmail-within-headers-p () "Check to see if point is within the headers of a unix mail message. Doesn't change point." diff --git a/lisp/nntp.el b/lisp/nntp.el index e41f8ed..ee68191 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -86,7 +86,8 @@ case, this list will be used as the parameter list given to rsh.") (defvoo nntp-rlogin-user-name nil "*User name on remote system when using the rlogin connect method.") -(defvoo nntp-telnet-parameters '("exec" "telnet" "-8" "${NNTPSERVER:=news}" "nntp") +(defvoo nntp-telnet-parameters + '("exec" "telnet" "-8" "${NNTPSERVER:=news}" "nntp") "*Parameters to `nntp-open-telnet'. That function may be used as `nntp-open-connection-function'. In that case, this list will be executed as a command after logging in diff --git a/lisp/nnvirtual.el b/lisp/nnvirtual.el index ca92c68..61fbc2b 100644 --- a/lisp/nnvirtual.el +++ b/lisp/nnvirtual.el @@ -453,7 +453,8 @@ If UPDATE-P is not nil, call gnus-group-update-group on the components." ;; hits C-g, you won't leave the component groups in a half-way state. (progn ;; move (un)read - (let ((gnus-newsgroup-active nil)) ;workaround guns-update-read-articles + ;; bind for workaround guns-update-read-articles + (let ((gnus-newsgroup-active nil)) (while (setq entry (pop unreads)) (gnus-update-read-articles (car entry) (cdr entry)))) diff --git a/lisp/parse-time.el b/lisp/parse-time.el index f076aea..ec0d071 100644 --- a/lisp/parse-time.el +++ b/lisp/parse-time.el @@ -36,7 +36,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) ;and ah ain't kiddin' 'bout it +(eval-when-compile (require 'cl)) ;and ah ain't kiddin' 'bout it (defvar parse-time-syntax (make-vector 256 nil)) (defvar parse-time-digits (make-vector 256 nil)) diff --git a/lisp/pop3-fma.el b/lisp/pop3-fma.el deleted file mode 100644 index 90db4d2..0000000 --- a/lisp/pop3-fma.el +++ /dev/null @@ -1,412 +0,0 @@ -;; pop3-fma.el.el --- POP3 for Multiple Account for Gnus. -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. , Tatsuya Ichikawa -;; Yasuo Okabe -;; Author: Tatsuya Ichikawa -;; Yasuo OKABE -;; Version: 1.17 -;; Keywords: mail , gnus , pop3 -;; -;; SPECIAL THANKS -;; Keiichi Suzuki -;; Katsumi Yamaoka -;; -;; This file is not 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: -;; -;; Note. -;; -;; This file store pop3 password in variable "pop3-fma-password". -;; Please take care by yourself to treat pop3 password. -;; -;; How to use. -;; -;; add your .emacs following codes. -;; -;; (require 'pop3-fma) -;; (setq pop3-fma-spool-file-alist -;; '( -;; ("po:username0@mailhost0.your.domain0" pass) -;; ("po:username1@mailhost1.your.domain1" apop) -;; : -;; : -;; )) -;; -;; pass means normal authentication USER/PASS. -;; apop means authentication using APOP. -;; -;; When using apop , Please set pop3-fma-movemail-type 'lisp. -;; movemail.exe does not work on APOP protocol. -;; -;; Variables -;; -;; pop3-fma-spool-file-alist ... Spool file alist of POP3 protocol -;; pop3-fma-movemail-type ... Type of movemail program. -;; 'lisp or 'exe -;; 'lisp use pop3.el -;; 'exe use movemail -;; pop3-fma-movemail-arguments ... List of options of movemail program. -;; -;;; Code: - -(require 'cl) -(require 'custom) - -(unless (and (condition-case () - (require 'custom) - (file-error nil)) - (fboundp 'defgroup) - (fboundp 'defcustom)) - (require 'backquote) - (defmacro defgroup (&rest args)) - (defmacro defcustom (symbol value &optional doc &rest args) - (` (defvar (, symbol) (, value) (, doc)))) - ) - -(defgroup pop3-fma nil - "Multile POP3 account utility for Gnus." - :prefix "pop3-fma-" - :group 'mail - :group 'news) - -(defconst pop3-fma-version-number "1.16") -(defconst pop3-fma-codename -;; "J boy" ; 1.00 -;; "Blood line" ; 1.10 -;; "Star ring" ; 1.11 -;; "Goodbye Game" ; 1.12 -;; "Love is Gamble" ; 1.13 -;; "Lonely" ; 1.14 -;; "Feel the wind" ; 1.16 - "Sadness like snow" ; 1.17 - ) -(defconst pop3-fma-version (format "Multiple POP3 account utiliy for Gnus v%s - \"%s\"" - pop3-fma-version-number - pop3-fma-codename)) - -(defcustom pop3-fma-spool-file-alist nil - "*Spool file to get mail using pop3 protocol. -You should specify this variable like - '( - (\"po:user1@mailhost1\" type) - (\"po:user2@mailhost2\" type) - ) -Type must be pass or apop." - :group 'pop3-fma - :type 'alist) - -(defcustom pop3-fma-local-spool-file-alist nil - "*List of Local spool file to get mail." - :group 'pop3-fma - :type 'alist) - -(defcustom pop3-fma-movemail-type 'lisp - "*Type of movemail program. -Lisp means `nnmail-movemail-program' is lisp function. - Exe means `nnmail-movemail-program' is external program. - Please do not use exe if you do not use Meadow." - :group 'pop3-fma - :type '(choice (const lisp) - (const exe))) - -(defcustom pop3-fma-movemail-arguments '("-pf") - "*Options for movemail." - :group 'pop3-fma - :type '(repeat (string :tag "Argument"))) - -(defcustom pop3-fma-save-password-information nil - "*If non nil , save POP Server's password information. -============== Important notice ===================== -Please take care of your password information. -If set to t , your pop3 password is saved in pop3-fma-password in raw text. -So , Anybody can see this information by describe-variable. -If there is any problem , please set this variable to nil(default). -============== Important notice =====================" - :group 'pop3-fma - :type 'boolean) - -;;; Internal variables. -(defvar pop3-fma-password nil - "*POP3 password , user , mailhost information for Gnus.") - -(defvar pop3-fma-movemail-program - (if (eq system-type 'windows-nt) - "movemail.exe" - "movemail") - "*External program name your movemail.") - - -;; Temporary variable -(defvar hdr nil) -(defvar passwd nil) -(defvar str nil) -(defvar spool nil) -(defvar movemail-output-buffer " *movemail-out*") -(defvar pop3-fma-commandline-arguments nil) - -;;; To silence byte compiler -(and - (fboundp 'eval-when-compile) - (eval-when-compile - (save-excursion - (beginning-of-defun) - (eval-region (point-min) (point))) - (let (case-fold-search) - (mapcar - (function - (lambda (symbol) - (unless (boundp symbol) - (make-local-variable symbol) - (eval (list 'setq symbol nil))))) - '(:group - :prefix :type - pop3-maildrop - pop3-mailhost - )) - (make-local-variable 'byte-compile-warnings) - (setq byte-compile-warnings nil)))) - -(defun pop3-fma-init-message-hook () - (add-hook 'message-send-hook 'pop3-fma-message-add-header)) - -(eval-after-load "message" - '(pop3-fma-init-message-hook)) - -(add-hook 'gnus-after-exiting-gnus-hook - '(lambda () (setq pop3-fma-password nil))) -(add-hook 'gnus-before-startup-hook 'pop3-fma-set-pop3-password) - -;; -;; -;; Gnus POP3 additional utility... -;; -(defun pop3-fma-movemail (inbox crashbox) - "Function to move mail from INBOX on a pop3 server to file CRASHBOX." - (if (string-match "^po:" inbox) - (progn - (let ((pop3-maildrop - (substring inbox (match-end (string-match "^po:" inbox)) - (- (match-end (string-match "^.*@" inbox)) 1))) - (pop3-mailhost - (substring inbox (match-end (string-match "^.*@" inbox)))) - (pop3-password - (if pop3-fma-save-password-information - (pop3-fma-read-passwd (substring inbox (match-end (string-match "^.*@" inbox)))) - (pop3-fma-input-password - (substring inbox (match-end (string-match "^.*@" inbox))) - (substring inbox (match-end (string-match "^po:" inbox)) - (- (match-end (string-match "^.*@" inbox)) 1))))) - (pop3-authentication-scheme - (nth 1 (assoc inbox pop3-fma-spool-file-alist)))) -;; (pop3-fma-movemail-type (pop3-fma-get-movemail-type inbox))) - (if (eq pop3-authentication-scheme 'pass) - (message "Checking new mail user %s at %s using USER/PASS ..." pop3-maildrop pop3-mailhost) - (message "Checking new mail user %s at %s using APOP ..." pop3-maildrop pop3-mailhost)) - (if (and (eq system-type 'windows-nt) - (eq pop3-fma-movemail-type 'exe)) - (progn - (setenv "MAILHOST" pop3-mailhost) - (if (and (not (memq pop3-password pop3-fma-commandline-arguments)) - (not (memq (concat "po:" pop3-maildrop) pop3-fma-commandline-arguments))) - (progn - (if (eq pop3-authentication-scheme 'apop) - (setq pop3-fma-commandline-arguments - (append - pop3-fma-movemail-arguments - (list - "-A" - (concat "po:" pop3-maildrop) - crashbox - pop3-password))) - (setq pop3-fma-commandline-arguments - (append - pop3-fma-movemail-arguments - (list - (concat "po:" pop3-maildrop) - crashbox - pop3-password)))))) - (if (not (get-buffer movemail-output-buffer)) - (get-buffer-create movemail-output-buffer)) - (set-buffer movemail-output-buffer) - (erase-buffer) - (apply 'call-process (concat - exec-directory - pop3-fma-movemail-program) - nil movemail-output-buffer nil - pop3-fma-commandline-arguments) - (let ((string (buffer-string))) - (if (> (length string) 0) - (progn - (if (y-or-n-p - (concat (substring string 0 - (- (length string) 1)) - " continue ??")) - nil - nil))))) - (pop3-movemail crashbox)))) - (message "Checking new mail at %s ... " inbox) - (call-process (concat exec-directory pop3-fma-movemail-program) - nil - nil - nil - inbox - crashbox) - (message "Checking new mail at %s ... done." inbox))) -;; -;; -(defun pop3-fma-read-passwd (mailhost) - (setq passwd (nth 2 (assoc mailhost pop3-fma-password))) - passwd) - -(defun pop3-fma-input-password (mailhost maildrop) - (pop3-fma-read-noecho - (format "POP Password for %s at %s: " maildrop mailhost) t)) - -(setq pop3-read-passwd 'pop3-fma-read-passwd - nnmail-read-passwd 'pop3-fma-read-passwd) -;; -;; Set multiple pop3 server's password -(defun pop3-fma-store-password (passwd) - (interactive - (list (pop3-fma-read-noecho - (format "POP Password for %s at %s: " pop3-maildrop pop3-mailhost) t))) - (if (not (assoc pop3-mailhost pop3-fma-password)) - (setq pop3-fma-password - (append pop3-fma-password - (list - (list - pop3-mailhost - pop3-maildrop - passwd))))) - (setcar (cdr (cdr (assoc pop3-mailhost pop3-fma-password))) - passwd) - (message "POP password registered.") - passwd) -;; -;;;###autoload -(defun pop3-fma-set-pop3-password() - (interactive) - (if pop3-fma-save-password-information - (progn - (mapcar - (lambda (x) - (let ((pop3-maildrop - (substring (car x) (match-end (string-match "^po:" (car x))) - (- (match-end (string-match "^.*@" (car x))) 1))) - (pop3-mailhost - (substring (car x) (match-end (string-match "^.*@" (car x)))))) - (call-interactively 'pop3-fma-store-password))) - pop3-fma-spool-file-alist))) - (setq nnmail-movemail-program 'pop3-fma-movemail) -;; (setq nnmail-spool-file pop3-fma-spool-file-alist)) - (setq nnmail-spool-file (append - pop3-fma-local-spool-file-alist - (mapcar - (lambda (spool) - (car spool)) - pop3-fma-spool-file-alist)))) -;; -(defmacro pop3-fma-read-char-exclusive () - (cond ((featurep 'xemacs) - '(let ((table (quote ((backspace . ?\C-h) (delete . ?\C-?) - (left . ?\C-h)))) - event key) - (while (not - (and - (key-press-event-p (setq event (next-command-event))) - (setq key (or (event-to-character event) - (cdr (assq (event-key event) table))))))) - key)) - ((fboundp 'read-char-exclusive) - '(read-char-exclusive)) - (t - '(read-char)))) -;; -(defun pop3-fma-read-noecho (prompt &optional stars) - "Read a single line of text from user without echoing, and return it. -Argument PROMPT ." - (let ((ans "") - (c 0) - (echo-keystrokes 0) - (cursor-in-echo-area t) - (log-message-max-size 0) - message-log-max done msg truncate) - (while (not done) - (if (or (not stars) (string-equal "" ans)) - (setq msg prompt) - (setq msg (concat prompt (make-string (length ans) ?*))) - (setq truncate - (1+ (- (length msg) (window-width (minibuffer-window))))) - (and (> truncate 0) - (setq msg (concat "$" (substring msg (1+ truncate)))))) - (message msg) - (setq c (pop3-fma-read-char-exclusive)) - (cond ((eq ?\C-g c) - (setq quit-flag t - done t)) - ((memq c '(?\r ?\n ?\e)) - (setq done t)) - ((eq ?\C-u c) - (setq ans "")) - ((and (/= ?\b c) (/= ?\177 c)) - (setq ans (concat ans (char-to-string c)))) - ((> (length ans) 0) - (setq ans (substring ans 0 -1))))) - (if quit-flag - (prog1 - (setq quit-flag nil) - (message "Quit") - (beep t)) - (message "") - ans))) -;; -;; -(defun pop3-fma-message-add-header () - (if (message-mail-p) - (pop3-fma-add-custom-header "X-Ya-Pop3:" pop3-fma-version))) - -;; -;; Add your custom header. -(defun pop3-fma-add-custom-header (header string) - (let ((delimline - (progn (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n")) - (point-marker)))) - (goto-char (point-min)) - (or (re-search-forward (concat "^" header) delimline t) - (progn - (goto-char delimline) - (forward-line -1) - (beginning-of-line) - (setq hdr (concat header " ")) - (setq str (concat hdr string)) - (setq hdr (concat str "\n")) - (insert-string hdr))))) -;; -;; -(defun pop3-fma-get-movemail-type (inbox) - (if (eq (nth 1 (assoc inbox pop3-fma-spool-file-alist)) 'apop) - 'lisp - pop3-fma-movemail-type)) -;; -(provide 'pop3-fma) -;; -;; pop3-fma.el ends here. - - diff --git a/lisp/pop3.el b/lisp/pop3.el index ec14722..571c979 100644 --- a/lisp/pop3.el +++ b/lisp/pop3.el @@ -104,7 +104,7 @@ Used for APOP authentication.") (pop3-quit process) (kill-buffer crashbuf) ) - ) + t) (defun pop3-open-server (mailhost port) "Open TCP connection to MAILHOST. diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index b68146a..7e2e570 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -134,9 +134,10 @@ Should be called narrowed to the head of the message." (defun rfc2047-encodable-p () "Say whether the current (narrowed) buffer contains characters that need encoding." - (let ((charsets (mapcar - 'mm-mule-charset-to-mime-charset - (mm-find-charset-region (point-min) (point-max)))) + (let ((charsets + (mapcar + 'mm-mime-charset + (mm-find-charset-region (point-min) (point-max)))) (cs (list 'us-ascii mail-parse-charset)) found) (while charsets @@ -183,10 +184,9 @@ Should be called narrowed to the head of the message." (defun rfc2047-encode (b e charset) "Encode the word in the region with CHARSET." - (let* ((mime-charset - (mm-mime-charset charset b e)) + (let* ((mime-charset (mm-mime-charset charset)) (encoding (or (cdr (assq mime-charset - rfc2047-charset-encoding-alist)) + rfc2047-charset-encoding-alist)) 'B)) (start (concat "=?" (downcase (symbol-name mime-charset)) "?" @@ -266,7 +266,8 @@ Should be called narrowed to the head of the message." (prog1 (match-string 0) (delete-region (match-beginning 0) (match-end 0))))) - (when (and (mm-multibyte-p) mail-parse-charset) + (when (and (mm-multibyte-p) + mail-parse-charset) (mm-decode-coding-region b e mail-parse-charset)) (setq b (point))) (when (and (mm-multibyte-p) diff --git a/lisp/smiley.el b/lisp/smiley.el index 891b0b7..76b10c7 100644 --- a/lisp/smiley.el +++ b/lisp/smiley.el @@ -280,10 +280,12 @@ above them." (set-extent-property ant 'smiley-extent ext) (set-extent-property ext 'smiley-annotation ant) ;; Help - (set-extent-property ext 'help-echo - "button2 toggles smiley, button3 pops up menu") - (set-extent-property ant 'help-echo - "button2 toggles smiley, button3 pops up menu") + (set-extent-property + ext 'help-echo + "button2 toggles smiley, button3 pops up menu") + (set-extent-property + ant 'help-echo + "button2 toggles smiley, button3 pops up menu") (set-extent-property ext 'balloon-help "Mouse button2 - toggle smiley Mouse button3 - menu") -- 1.7.10.4