From: Lars Magne Ingebrigtsen Date: Mon, 13 Mar 2000 19:43:15 +0000 (+0000) Subject: * gnus-srvr.el (gnus-server-kill-server): Offer to kill all the X-Git-Url: http://cgit.sxemacs.org/?a=commitdiff_plain;h=1e0b7c8f28af61d32adccd6514e2968814dbbacb;p=gnus * gnus-srvr.el (gnus-server-kill-server): Offer to kill all the groups from the server. * gnus-sum.el (gnus-summary-save-parts): Fix interactive spec. (gnus-summary-toggle-header): Update the wash status. * gnus-uu.el ((gnus-uu-extract-map "X" gnus-summary-mode-map)): Moved here. * gnus-agent.el (gnus-agent-save-group-info): Respect old setting. * nnmail.el (nnmail-get-active): Use it. (nnmail-parse-active): New function. * mm-view.el (mm-inline-text): Support the new version of vcard.el. * gnus-sum.el (gnus-summary-move-article): Only delete article when moving junk. (gnus-deaden-summary): Bury the buffer. * nnmail.el (nnmail-group-pathname): Ditto. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3a6a3486a..bef4ad62b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,23 @@ 2000-03-13 13:51:38 Lars Magne Ingebrigtsen + * gnus-srvr.el (gnus-server-kill-server): Offer to kill all the + groups from the server. + + * gnus-sum.el (gnus-summary-save-parts): Fix interactive spec. + (gnus-summary-toggle-header): Update the wash status. + + * gnus-uu.el ((gnus-uu-extract-map "X" gnus-summary-mode-map)): + Moved here. + + * gnus-agent.el (gnus-agent-save-group-info): Respect old + setting. + + * nnmail.el (nnmail-get-active): Use it. + (nnmail-parse-active): New function. + + * mm-view.el (mm-inline-text): Support the new version of + vcard.el. + * gnus-sum.el (gnus-summary-move-article): Only delete article when moving junk. (gnus-deaden-summary): Bury the buffer. @@ -8,6 +26,11 @@ * nnheader.el (nnheader-group-pathname): Use expand-file-name. +2000-03-13 20:23:06 Christoph Rohland + + * rfc2047.el (rfc2047-encode-message-header): Encode no matter + whether Mule. + 2000-03-10 14:57:58 Lars Magne Ingebrigtsen * message.el (message-send-mail): Protect against unloaded Gnus. diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 79ed84584..4e9ddd8ec 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -621,7 +621,8 @@ the actual number of articles toggled is returned." (defun gnus-agent-save-group-info (method group active) (when (gnus-agent-method-p method) (let* ((gnus-command-method method) - (file (gnus-agent-lib-file "active"))) + (file (gnus-agent-lib-file "active")) + oactive) (gnus-make-directory (file-name-directory file)) (with-temp-file file (when (file-exists-p file) @@ -629,9 +630,17 @@ the actual number of articles toggled is returned." (goto-char (point-min)) (when (re-search-forward (concat "^" (regexp-quote group) " ") nil t) + (save-excursion + (save-restriction + (narrow-to-region (match-beginning 0) + (progn + (forward-line 1) + (point))) + (setq oactive (car (nnmail-parse-active))))) (gnus-delete-line)) - (insert (format "%S %d %d y\n" (intern group) (cdr active) - (car active))) + (insert (format "%S %d %d y\n" (intern group) + (cdr active) + (or (car oactive) (car active)))) (goto-char (point-max)) (while (search-backward "\\." nil t) (delete-char 1)))))) diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el index bba79f09f..9057e2144 100644 --- a/lisp/gnus-srvr.el +++ b/lisp/gnus-srvr.el @@ -296,6 +296,18 @@ The following commands are available: (push (assoc server gnus-server-alist) gnus-server-killed-servers) (setq gnus-server-alist (delq (car gnus-server-killed-servers) gnus-server-alist)) + (let ((groups (gnus-groups-from-server server))) + (when (and groups + (gnus-yes-or-no-p + (format "Kill all %s groups from this server? " + (length groups)))) + (dolist (group groups) + (setq gnus-newsrc-alist + (delq (assoc group gnus-newsrc-alist) + gnus-newsrc-alist)) + (when gnus-group-change-level-function + (funcall gnus-group-change-level-function + group gnus-level-killed 3))))) (gnus-server-position-point)) (defun gnus-server-yank-server () diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 405bd8df6..25bc11f3e 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1899,7 +1899,10 @@ newsgroup." (gnus-group-prefixed-name "" method)))) ;; Let the Gnus agent save the active file. - (if (and gnus-agent real-active gnus-plugged (gnus-agent-method-p method)) + (if (and gnus-agent + real-active + gnus-plugged + (gnus-agent-method-p method)) (progn (gnus-agent-save-groups method) (gnus-active-to-gnus-format method hashtb nil real-active)) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index ff55b9648..fb0663f16 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -7236,8 +7236,11 @@ If ARG is a negative number, hide the unwanted header lines." (if hidden (let ((gnus-treat-hide-headers nil) (gnus-treat-hide-boring-headers nil)) + (setq gnus-article-wash-types + (delq 'headers gnus-article-wash-types)) (gnus-treat-article 'head)) - (gnus-treat-article 'head))))))) + (gnus-treat-article 'head))) + (gnus-set-mode-line 'article))))) (defun gnus-summary-show-all-headers () "Make all header lines visible." @@ -9044,12 +9047,12 @@ save those articles instead." (error "No such group: %s" to-newsgroup))) to-newsgroup)) -(defun gnus-summary-save-parts (type dir n reverse) +(defun gnus-summary-save-parts (type dir n &optional reverse) "Save parts matching TYPE to DIR. If REVERSE, save parts that do not match TYPE." (interactive (list (read-string "Save parts of type: " "image/.*") - (read-file-name "Save to directory: " t nil t) + (read-file-name "Save to directory: " nil nil t) current-prefix-arg)) (gnus-summary-iterate n (let ((gnus-display-mime-function nil) diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index 5c94034d0..b5b18cf68 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -594,7 +594,8 @@ articles in the topic and its subtopics." (let* ((topic (gnus-group-topic group)) (groups (cdr (assoc topic gnus-topic-alist))) (g (cdr (member group groups))) - (unfound t)) + (unfound t) + entry) ;; Try to jump to a visible group. (while (and g (not (gnus-group-goto-group (car g) t))) (pop g)) @@ -632,7 +633,7 @@ articles in the topic and its subtopics." (tp (reverse (cddr top)))) (if (not top) (gnus-topic-insert-topic-line - topic t t (car (gnus-topic-find-topology topic)) nil unread) + topic t t (car (gnus-topic-find-topology topic)) nil 0) (while (not (equal (caaar tp) topic)) (setq tp (cdr tp))) (pop tp) diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index 8418f2609..1f4ed39e2 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -369,12 +369,11 @@ didn't work, and overwrite existing files. Otherwise, ask each time." "k" gnus-summary-kill-process-mark "y" gnus-summary-yank-process-mark "w" gnus-summary-save-process-mark - "i" gnus-uu-invert-processable - "m" gnus-summary-save-parts) + "i" gnus-uu-invert-processable) (gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map) ;;"x" gnus-uu-extract-any - ;;"m" gnus-uu-extract-mime + "m" gnus-summary-save-parts "u" gnus-uu-decode-uu "U" gnus-uu-decode-uu-and-save "s" gnus-uu-decode-unshar diff --git a/lisp/lpath.el b/lisp/lpath.el index 8fe4c1691..7302cda11 100644 --- a/lisp/lpath.el +++ b/lisp/lpath.el @@ -41,7 +41,8 @@ rmail-summary-exists rmail-select-summary rmail-update-summary url-retrieve temp-directory babel-fetch babel-wash - find-coding-systems-for-charsets sc-cite-regexp)) + find-coding-systems-for-charsets sc-cite-regexp + vcard-pretty-print)) (maybe-bind '(global-face-data mark-active transient-mark-mode mouse-selection-click-count mouse-selection-click-count-buffer buffer-display-table @@ -57,7 +58,8 @@ url-current-callback-func url-current-callback-data url-be-asynchronous temporary-file-directory babel-translations babel-history - display-time-mail-function))) + display-time-mail-function imap-password + ))) (maybe-bind '(mail-mode-hook enable-multibyte-characters browse-url-browser-function adaptive-fill-first-line-regexp adaptive-fill-regexp @@ -65,7 +67,7 @@ w3-meta-content-type-charset-regexp w3-meta-charset-content-type-regexp babel-translations babel-history - display-time-mail-function)) + display-time-mail-function imap-password)) (maybe-fbind '(color-instance-rgb-components temp-directory glyph-width annotation-glyph window-pixel-width glyph-height @@ -91,7 +93,8 @@ w3-coding-system-for-mime-charset rmail-summary-exists rmail-select-summary rmail-update-summary url-generic-parse-url valid-image-instantiator-format-p - babel-fetch babel-wash babel-as-string sc-cite-regexp))) + babel-fetch babel-wash babel-as-string sc-cite-regexp + vcard-pretty-print))) (setq load-path (cons "." load-path)) (require 'custom) diff --git a/lisp/mm-view.el b/lisp/mm-view.el index 6dcc35f6e..5a839835c 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -127,9 +127,11 @@ (mm-insert-inline handle (concat "\n-- \n" - (vcard-format-string - (vcard-parse-string (mm-get-part handle) - 'vcard-standard-filter))))) + (if (fboundp 'vcard-pretty-print) + (vcard-pretty-print (mm-get-part handle)) + (vcard-format-string + (vcard-parse-string (mm-get-part handle) + 'vcard-standard-filter)))))) (t (setq text (mm-get-part handle)) (let ((b (point)) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 67f517d7a..4a31d2a8b 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -482,31 +482,35 @@ parameter. It should return nil, `warn' or `delete'." (defun nnmail-get-active () "Returns an assoc of group names and active ranges. nn*-request-list should have been called before calling this function." - (let (group-assoc) - ;; Go through all groups from the active list. - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (unless (re-search-forward "[\\\"]" nil t) - (goto-char (point-max)) - (while (re-search-backward "[][';?()#]" nil t) - (insert ?\\))) - (goto-char (point-min)) - (let (group max min) - (while (not (eobp)) - (condition-case err - (progn - (narrow-to-region (point) (gnus-point-at-eol)) - (setq group (read nntp-server-buffer)) - (unless (stringp group) - (setq group (symbol-name group))) - (if (and (numberp (setq max (read nntp-server-buffer))) - (numberp (setq min (read nntp-server-buffer)))) - (push (list group (cons min max)) - group-assoc))) - (error nil)) - (widen) - (forward-line 1)))) + ;; Go through all groups from the active list. + (save-excursion + (set-buffer nntp-server-buffer) + (nnmail-parse-active))) + +(defun nnmail-parse-active () + "Parse the active file in the current buffer and return an alist." + (goto-char (point-min)) + (unless (re-search-forward "[\\\"]" nil t) + (goto-char (point-max)) + (while (re-search-backward "[][';?()#]" nil t) + (insert ?\\))) + (goto-char (point-min)) + (let ((buffer (current-buffer)) + group-assoc group max min) + (while (not (eobp)) + (condition-case err + (progn + (narrow-to-region (point) (gnus-point-at-eol)) + (setq group (read buffer)) + (unless (stringp group) + (setq group (symbol-name group))) + (if (and (numberp (setq max (read nntp-server-buffer))) + (numberp (setq min (read nntp-server-buffer)))) + (push (list group (cons min max)) + group-assoc))) + (error nil)) + (widen) + (forward-line 1)) group-assoc)) (defvar nnmail-active-file-coding-system 'raw-text diff --git a/lisp/nnml.el b/lisp/nnml.el index fd7d2161f..212251d5c 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -41,11 +41,11 @@ "Spool directory for the nnml mail backend.") (defvoo nnml-active-file - (concat (file-name-as-directory nnml-directory) "active") + (expand-file-name "active" nnml-directory) "Mail active file.") (defvoo nnml-newsgroups-file - (concat (file-name-as-directory nnml-directory) "newsgroups") + (expand-file-name "newsgroups" nnml-directory) "Mail newsgroups description file.") (defvoo nnml-get-new-mail t @@ -372,8 +372,8 @@ all. This may very well take some time.") (nnmail-write-region (point-min) (point-max) (or (nnml-article-to-file article) - (concat nnml-current-directory - (int-to-string article))) + (expand-file-name (int-to-string article) + nnml-current-directory)) nil (if (nnheader-be-verbose 5) nil 'nomesg)) t) (setq headers (nnml-parse-head chars article)) @@ -477,7 +477,7 @@ all. This may very well take some time.") (nnml-update-file-alist) (let (file) (if (setq file (cdr (assq article nnml-article-file-alist))) - (concat nnml-current-directory file) + (expand-file-name file nnml-current-directory) ;; Just to make sure nothing went wrong when reading over NFS -- ;; check once more. (when (file-exists-p @@ -518,8 +518,8 @@ all. This may very well take some time.") (defun nnml-find-id (group id) (erase-buffer) - (let ((nov (concat (nnmail-group-pathname group nnml-directory) - nnml-nov-file-name)) + (let ((nov (expand-file-name nnml-nov-file-name + (nnmail-group-pathname group nnml-directory))) number found) (when (file-exists-p nov) (nnheader-insert-file-contents nov) @@ -539,7 +539,7 @@ all. This may very well take some time.") (defun nnml-retrieve-headers-with-nov (articles &optional fetch-old) (if (or gnus-nov-is-evil nnml-nov-is-evil) nil - (let ((nov (concat nnml-current-directory nnml-nov-file-name))) + (let ((nov (expand-file-name nnml-nov-file-name nnml-current-directory))) (when (file-exists-p nov) (save-excursion (set-buffer nntp-server-buffer) @@ -635,8 +635,8 @@ all. This may very well take some time.") (push (list group active) nnml-group-alist)) (setcdr active (1+ (cdr active))) (while (file-exists-p - (concat (nnmail-group-pathname group nnml-directory) - (int-to-string (cdr active)))) + (expand-file-name (int-to-string (cdr active)) + (nnmail-group-pathname group nnml-directory))) (setcdr active (1+ (cdr active)))) (cdr active))) @@ -676,8 +676,9 @@ all. This may very well take some time.") (save-excursion (set-buffer buffer) (set (make-local-variable 'nnml-nov-buffer-file-name) - (concat (nnmail-group-pathname group nnml-directory) - nnml-nov-file-name)) + (expand-file-name + nnml-nov-file-name + (nnmail-group-pathname group nnml-directory))) (erase-buffer) (when (file-exists-p nnml-nov-buffer-file-name) (nnheader-insert-file-contents nnml-nov-buffer-file-name))) diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index 74705daa5..e01d7b8bf 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -105,33 +105,31 @@ Valid encodings are nil, `Q' and `B'.") "Encode the message header according to `rfc2047-header-encoding-alist'. Should be called narrowed to the head of the message." (interactive "*") - (when (featurep 'mule) - (save-excursion - (goto-char (point-min)) - (let ((alist rfc2047-header-encoding-alist) - elem method) - (while (not (eobp)) - (save-restriction - (rfc2047-narrow-to-field) - (when (rfc2047-encodable-p) - ;; We found something that may perhaps be encoded. - (while (setq elem (pop alist)) - (when (or (and (stringp (car elem)) - (looking-at (car elem))) - (eq (car elem) t)) - (setq alist nil - method (cdr elem)))) - (when method - (cond - ((eq method 'mime) - (rfc2047-encode-region (point-min) (point-max)) - (rfc2047-fold-region (point-min) (point-max))) - ;; Hm. - (t)))) - (goto-char (point-max))))) - (when mail-parse-charset - (encode-coding-region (point-min) (point-max) - mail-parse-charset))))) + (save-excursion + (goto-char (point-min)) + (let ((alist rfc2047-header-encoding-alist) + elem method) + (while (not (eobp)) + (save-restriction + (rfc2047-narrow-to-field) + (when (rfc2047-encodable-p) + ;; We found something that may perhaps be encoded. + (while (setq elem (pop alist)) + (when (or (and (stringp (car elem)) + (looking-at (car elem))) + (eq (car elem) t)) + (setq alist nil + method (cdr elem)))) + (cond + ((eq method 'mime) + (rfc2047-encode-region (point-min) (point-max)) + (rfc2047-fold-region (point-min) (point-max))) + ;; Hm. + (t))) + (goto-char (point-max))))) + (when mail-parse-charset + (encode-coding-region + (point-min) (point-max) mail-parse-charset)))) (defun rfc2047-encodable-p (&optional header) "Say whether the current (narrowed) buffer contains characters that need encoding in headers."