From: yamaoka Date: Tue, 23 Apr 2002 22:09:28 +0000 (+0000) Subject: Synch with Oort Gnus. X-Git-Tag: t-gnus-6_15_7-00-quimby~12 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=762bf06267f839770f0f576198db4f1be12f0d7b;p=elisp%2Fgnus.git- Synch with Oort Gnus. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 82ad76a..4c9d84d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,18 @@ +2002-04-23 Simon Josefsson + + * netrc.el: New file, functions copied from gnus-util.el by Ted + Zlatanov . + + * gnus-util.el: Require netrc. + (gnus-netrc-get, gnus-netrc-machine, gnus-parse-netrc): Aliased to + new code in netrc.el. + +2002-04-23 Kai Gro,A_(Bjohann + + * gnus-msg.el (gnus-summary-resend-message-edit): Remove + message-ignored-resent-headers, too. From Matthieu Moy + . + 2002-04-22 Bj,Av(Brn Torkelsson * gnus-srvr.el (gnus-server-browse-in-group-buffer): it is a diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 2b373f5..a8851a1 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -1332,6 +1332,7 @@ composing a new message." ;; Gnus will generate a new one when sending. (message-remove-header "Message-ID") + (message-remove-header message-ignored-resent-headers t) ;; Remove unwanted headers. (goto-char (point-max)) (insert mail-header-separator) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index fd4a0bd..93d2c57 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -41,6 +41,7 @@ (require 'custom) (require 'nnheader) (require 'time-date) +(require 'netrc) (eval-and-compile (autoload 'message-fetch-field "message") @@ -65,6 +66,11 @@ (setq start (- (length string) tail)))) string)))) +;;; bring in the netrc functions as aliases +(defalias 'gnus-netrc-get 'netrc-get) +(defalias 'gnus-netrc-machine 'netrc-machine) +(defalias 'gnus-parse-netrc 'netrc-parse) + (defun gnus-boundp (variable) "Return non-nil if VARIABLE is bound and non-nil." (and (boundp variable) @@ -946,93 +952,6 @@ ARG is passed to the first function." (apply 'run-hooks funcs) (set-buffer buf)))) -;;; -;;; .netrc and .authinforc parsing -;;; - -(defun gnus-parse-netrc (file) - "Parse FILE and return an list of all entries in the file." - (when (file-exists-p file) - (with-temp-buffer - (let ((tokens '("machine" "default" "login" - "password" "account" "macdef" "force" - "port")) - alist elem result pair) - (insert-file-contents file) - (goto-char (point-min)) - ;; Go through the file, line by line. - (while (not (eobp)) - (narrow-to-region (point) (gnus-point-at-eol)) - ;; For each line, get the tokens and values. - (while (not (eobp)) - (skip-chars-forward "\t ") - ;; Skip lines that begin with a "#". - (if (eq (char-after) ?#) - (goto-char (point-max)) - (unless (eobp) - (setq elem - (if (= (following-char) ?\") - (read (current-buffer)) - (buffer-substring - (point) (progn (skip-chars-forward "^\t ") - (point))))) - (cond - ((equal elem "macdef") - ;; We skip past the macro definition. - (widen) - (while (and (zerop (forward-line 1)) - (looking-at "$"))) - (narrow-to-region (point) (point))) - ((member elem tokens) - ;; Tokens that don't have a following value are ignored, - ;; except "default". - (when (and pair (or (cdr pair) - (equal (car pair) "default"))) - (push pair alist)) - (setq pair (list elem))) - (t - ;; Values that haven't got a preceding token are ignored. - (when pair - (setcdr pair elem) - (push pair alist) - (setq pair nil))))))) - (when alist - (push (nreverse alist) result)) - (setq alist nil - pair nil) - (widen) - (forward-line 1)) - (nreverse result))))) - -(defun gnus-netrc-machine (list machine &optional port defaultport) - "Return the netrc values from LIST for MACHINE or for the default entry. -If PORT specified, only return entries with matching port tokens. -Entries without port tokens default to DEFAULTPORT." - (let ((rest list) - result) - (while list - (when (equal (cdr (assoc "machine" (car list))) machine) - (push (car list) result)) - (pop list)) - (unless result - ;; No machine name matches, so we look for default entries. - (while rest - (when (assoc "default" (car rest)) - (push (car rest) result)) - (pop rest))) - (when result - (setq result (nreverse result)) - (while (and result - (not (equal (or port defaultport "nntp") - (or (gnus-netrc-get (car result) "port") - defaultport "nntp")))) - (pop result)) - (car result)))) - -(defun gnus-netrc-get (alist type) - "Return the value of token TYPE from ALIST." - (cdr (assoc type alist))) - ;;; Various (defvar gnus-group-buffer) ; Compiler directive diff --git a/lisp/netrc.el b/lisp/netrc.el new file mode 100644 index 0000000..3bfc76d --- /dev/null +++ b/lisp/netrc.el @@ -0,0 +1,128 @@ +;;; netrc.el --- .netrc parsing functionality +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 +;; Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen +;; Modularizer: Ted Zlatanov +;; Keywords: news + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; Just the .netrc parsing functionality, abstracted so other packages +;; besides Gnus can use it. + +;;; Code: + +;;; +;;; .netrc and .authinforc parsing +;;; + +(eval-and-compile + (defalias 'netrc-point-at-eol + (if (fboundp 'point-at-eol) + 'point-at-eol + 'line-end-position))) + +(defun netrc-parse (file) + "Parse FILE and return an list of all entries in the file." + (when (file-exists-p file) + (with-temp-buffer + (let ((tokens '("machine" "default" "login" + "password" "account" "macdef" "force" + "port")) + alist elem result pair) + (insert-file-contents file) + (goto-char (point-min)) + ;; Go through the file, line by line. + (while (not (eobp)) + (narrow-to-region (point) (netrc-point-at-eol)) + ;; For each line, get the tokens and values. + (while (not (eobp)) + (skip-chars-forward "\t ") + ;; Skip lines that begin with a "#". + (if (eq (char-after) ?#) + (goto-char (point-max)) + (unless (eobp) + (setq elem + (if (= (following-char) ?\") + (read (current-buffer)) + (buffer-substring + (point) (progn (skip-chars-forward "^\t ") + (point))))) + (cond + ((equal elem "macdef") + ;; We skip past the macro definition. + (widen) + (while (and (zerop (forward-line 1)) + (looking-at "$"))) + (narrow-to-region (point) (point))) + ((member elem tokens) + ;; Tokens that don't have a following value are ignored, + ;; except "default". + (when (and pair (or (cdr pair) + (equal (car pair) "default"))) + (push pair alist)) + (setq pair (list elem))) + (t + ;; Values that haven't got a preceding token are ignored. + (when pair + (setcdr pair elem) + (push pair alist) + (setq pair nil))))))) + (when alist + (push (nreverse alist) result)) + (setq alist nil + pair nil) + (widen) + (forward-line 1)) + (nreverse result))))) + +(defun netrc-machine (list machine &optional port defaultport) + "Return the netrc values from LIST for MACHINE or for the default entry. +If PORT specified, only return entries with matching port tokens. +Entries without port tokens default to DEFAULTPORT." + (let ((rest list) + result) + (while list + (when (equal (cdr (assoc "machine" (car list))) machine) + (push (car list) result)) + (pop list)) + (unless result + ;; No machine name matches, so we look for default entries. + (while rest + (when (assoc "default" (car rest)) + (push (car rest) result)) + (pop rest))) + (when result + (setq result (nreverse result)) + (while (and result + (not (equal (or port defaultport "nntp") + (or (netrc-get (car result) "port") + defaultport "nntp")))) + (pop result)) + (car result)))) + +(defun netrc-get (alist type) + "Return the value of token TYPE from ALIST." + (cdr (assoc type alist))) + +(provide 'netrc) + +;;; netrc.el ends here