*** \\1-expressions are now valid in `nnmail-split-methods'.
+*** The `custom-face-lookup' function has been removed.
+If you used this function in your initialization files, you must
+rewrite them to use `face-spec-set' instead.
+
+*** Cancelling now uses the current select method. Symbolic prefix
+`a' forces normal posting method.
+
+*** New command to translate M******** sm*rtq**t*s into proper text
+-- `W d'.
+
* gnus.el: Quassia Gnus v0.1 is released.
+Thu Nov 6 20:43:05 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Quassia Gnus v0.13 is released.
+
+Thu Nov 6 20:30:14 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * nnlistserv.el: New backend.
+
+Thu Nov 6 01:53:51 1997 Stefan Waldherr <swa@cs.cmu.edu>
+
+ * nnweb.el (nnweb-dejanewsold-search): New function.
+
+Thu Nov 6 01:52:43 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-topic.el (gnus-topic-change-level): Really delete multiple
+ instances.
+
+Wed Nov 5 14:04:54 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-topic.el (gnus-topic-update-topic-line): Possibly fix nil
+ numbers.
+
+ * gnus-sum.el (gnus-summary-show-article): New command and
+ keystroke.
+
+Tue Nov 4 06:29:58 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-score.el (gnus-score-adaptive): Use the home score file.
+
+Sat Oct 25 05:52:22 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-art.el (gnus-article-save): Hide headers in the right
+ buffer.
+
+ * gnus-picon.el (gnus-picons-xbm-face): New face.
+
+Sat Oct 25 00:39:42 1997 Lars Balker Rasmussen <lbr@mjolner.dk>
+
+ * gnus-art.el (gnus-article-fill-paragraph): New command and
+ keystroke.
+
+1997-10-16 Colin Rafferty <craffert@ml.com>
+
+ * message.el (message-make-fqdn): Made certain that user-mail is
+ not nil.
+
+Sat Oct 25 00:18:32 1997 David S. Goldberg <dsg@linus.mitre.org>
+
+ * gnus-art.el (article-hide-boring-headers): Use many-to.
+
+Fri Oct 24 23:48:39 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-picon.el (gnus-picons-display-pairs): Don't add two bars.
+ (gnus-picons-try-face): Set the foreground color on the bar.
+ (gnus-picons-group-exluded-groups): New variable.
+ (gnus-group-display-picons): Use it.
+
+Mon Oct 13 00:01:35 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-agent.el (gnus-agent-group-path): Translate file chars.
+ (gnus-agent-batch-fetch): New command.
+ (gnus-agent-fetch-group): Message.
+
+Sun Oct 12 23:54:55 1997 ISO-2022-JP <ichikawa@hv.epson.co.jp>
+
+ * gnus-agent.el (gnus-agent-article-file-coding-system): New
+ variable.
+
+Sun Oct 12 16:46:11 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * dgnushack.el (lpath): Reversed.
+
+ * gnus-msg.el (gnus-summary-cancel-article): Use sym prefix.
+
+ * gnus-art.el (article-translate-characters): New function.
+ (article-treat-dumbquotes): New command and keystroke.
+
+Sun Oct 5 20:09:31 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-art.el (gnus-button-alist): No ' and " in News:.
+
+ * gnus-msg.el (gnus-inews-insert-archive-gcc): Comp warn.
+
Sat Oct 4 00:53:55 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Quassia Gnus v0.12 is released.
Sat Oct 4 00:16:39 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+ * gnus.el (gnus-plugged): Moved here.
+
* nnmail.el (nnmail-delete-incoming): Changed default to nil.
* gnus-int.el (gnus-request-scan): Don't do anything if
(require 'cl)
(require 'bytecomp)
-(push "." load-path)
(push "~/lisp/custom" load-path)
+(push "." load-path)
(require 'lpath)
(defalias 'device-sound-enabled-p 'ignore)
file elc)
(condition-case ()
(require 'w3-forms)
- (error (setq files (delete "nnweb.el" files))))
+ (error (setq files (delete "nnweb.el" (delete "nnlistserv.el" files)))))
(while (setq file (pop files))
(when (or (and (not xemacs)
(not (member file '("gnus-xmas.el" "gnus-picon.el"
(defvar gnus-agent-spam-hashtb nil)
(defvar gnus-agent-file-name nil)
(defvar gnus-agent-send-mail-function nil)
+(defvar gnus-agent-article-file-coding-system 'no-conversion)
;; Dynamic variables
(defvar gnus-headers)
(error "No group on the current line"))
(let ((gnus-command-method (gnus-find-method-for-group group)))
(gnus-agent-with-fetch
- (gnus-agent-fetch-group-1 group gnus-command-method))))
+ (gnus-agent-fetch-group-1 group gnus-command-method)
+ (gnus-message 5 "Fetching %s...done" group))))
(defun gnus-agent-add-group (category arg)
"Add the current group to an agent category."
(let* ((gnus-command-method method)
(file (gnus-agent-lib-file "active")))
(gnus-make-directory (file-name-directory file))
- (write-region (point-min) (point-max) file nil 'silent)
+ (let ((coding-system-for-write gnus-agent-article-file-coding-system))
+ (write-region (point-min) (point-max) file nil 'silent))
(when (file-exists-p (gnus-agent-lib-file "groups"))
(delete-file (gnus-agent-lib-file "groups"))))))
(defun gnus-agent-group-path (group)
"Translate GROUP into a path."
- (nnheader-replace-chars-in-string group ?. ?/))
+ (nnheader-translate-file-chars
+ (nnheader-replace-chars-in-string group ?. ?/)))
\f
(concat (gnus-agent-directory) (gnus-agent-group-path group) "/"
(if (stringp article) article (string-to-number article))))
+;;;###autoload
+(defun gnus-agent-batch-fetch ()
+ "Start Gnus and fetch session."
+ (interactive)
+ (gnus)
+ (gnus-agent-fetch-session)
+ (gnus-group-exit))
+
(defun gnus-agent-fetch-session ()
"Fetch all articles and headers that are eligible for fetching."
(interactive)
(defcustom gnus-boring-article-headers '(empty followup-to reply-to)
"Headers that are only to be displayed if they have interesting data.
Possible values in this list are `empty', `newsgroups', `followup-to',
-`reply-to', and `date'."
+`reply-to', `date', `long-to', and `many-to'."
:type '(set (const :tag "Headers with no content." empty)
(const :tag "Newsgroups with only one group." newsgroups)
(const :tag "Followup-to identical to newsgroups." followup-to)
(const :tag "Reply-to identical to from." reply-to)
(const :tag "Date less than four days old." date)
- (const :tag "Very long To header." long-to))
+ (const :tag "Very long To header." long-to)
+ (const :tag "Multiple To headers." many-to))
:group 'gnus-article-hiding)
(defcustom gnus-signature-separator '("^-- $" "^-- *$")
If given a negative prefix, always show; if given a positive prefix,
always hide."
(interactive (gnus-article-hidden-arg))
+ (current-buffer)
(if (gnus-article-check-hidden-text 'headers arg)
;; Show boring headers as well.
(gnus-article-show-hidden-text 'boring-headers)
((eq elem 'long-to)
(let ((to (message-fetch-field "to")))
(when (> (length to) 1024)
- (gnus-article-hide-header "to")))))))))))
+ (gnus-article-hide-header "to"))))
+ ((eq elem 'many-to)
+ (let ((to-count 0))
+ (goto-char (point-min))
+ (while (re-search-forward "^to:" nil t)
+ (setq to-count (1+ to-count)))
+ (when (> to-count 1)
+ (while (> to-count 0)
+ (goto-char (point-min))
+ (save-restriction
+ (re-search-forward "^to:" nil nil to-count)
+ (forward-line -1)
+ (narrow-to-region (point) (point-max))
+ (gnus-article-hide-header "to"))
+ (setq to-count (1- to-count)))))))))))))
(defun gnus-article-hide-header (header)
(save-excursion
(point-max)))
'boring-headers))))
-;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
+(defun article-treat-dumbquotes ()
+ "Translate M******** sm*rtq**t*s into proper text."
+ (interactive)
+ (article-translate-characters "\221\222\223\223" "`'\"\""))
+
+(defun article-translate-characters (from to)
+ "Translate all characters in the body of the article according to FROM and TO.
+FROM is a string of characters to translate from; to is a string of
+characters to translate to."
+ (save-excursion
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ (let ((buffer-read-only nil)
+ (x (make-string 225 ?x))
+ (i -1))
+ (while (< (incf i) (length x))
+ (aset x i i))
+ (setq i 0)
+ (while (< i (length from))
+ (aset x (aref from i) (aref to i))
+ (incf i))
+ (translate-region (point) (point-max) x)))))
+
(defun article-treat-overstrike ()
"Translate overstrikes into bold text."
(interactive)
(let ((gnus-visible-headers
(or gnus-saved-headers gnus-visible-headers))
(gnus-article-buffer save-buffer))
- (gnus-article-hide-headers 1 t)))
+ (save-excursion
+ (set-buffer save-buffer)
+ (article-hide-headers 1 t))))
(save-window-excursion
(if (not gnus-default-article-saver)
(error "No default saver is defined")
article-date-user
article-date-lapsed
article-emphasize
+ article-treat-dumbquotes
(article-show-all . gnus-article-show-all-headers))))
\f
;;;
("\\bnews:\\([^>\n\t ]*@[^>\n\t ]*\\)" 0 t gnus-button-message-id 1)
("\\(\\b<\\(url: ?\\)?news:\\(//\\)?\\([^>\n\t ]*\\)>\\)" 1 t
gnus-button-fetch-group 4)
- ("\\bnews:\\(//\\)?\\([^>\n\t ]+\\)" 0 t gnus-button-fetch-group 2)
+ ("\\bnews:\\(//\\)?\\([^'\">\n\t ]+\\)" 0 t gnus-button-fetch-group 2)
("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2
t gnus-button-message-id 3)
("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>" 0 t gnus-url-mailto 2)
gnus-list-of-killed-groups)
(setcdr (cdr entry) (cdddr entry)))
((member group gnus-zombie-list)
- (setq gnus-zombie-list (delete group gnus-zombie-list)))))
+ (setq gnus-zombie-list (delete group gnus-zombie-list))))
+ ;; There may be more than one instance displayed.
+ (while (gnus-group-goto-group group)
+ (gnus-delete-line)))
(gnus-make-hashtable-from-newsrc-alist)))
(gnus-group-position-point)
(push-mark)
(goto-char beg)))
-(defun gnus-summary-cancel-article (n)
- "Cancel an article you posted."
- (interactive "P")
+(defun gnus-summary-cancel-article (&optional n symp)
+ "Cancel an article you posted.
+Uses the process-prefix convention. If given the symbolic
+prefix `a', cancel using the standard posting method; if not
+post using the current select method."
+ (interactive (gnus-interactive "P\ny"))
(gnus-set-global-variables)
(let ((articles (gnus-summary-work-articles n))
(message-post-method
`(lambda (arg)
- (gnus-post-method nil ,gnus-newsgroup-name)))
+ (gnus-post-method (not (eq symp 'a)) ,gnus-newsgroup-name)))
article)
(while (setq article (pop articles))
(when (gnus-summary-select-article t nil nil article)
(group (or group gnus-newsgroup-name ""))
(gcc-self-val
(and gnus-newsgroup-name
- (setq gcc-self-val
- (gnus-group-find-parameter
- gnus-newsgroup-name 'gcc-self))))
+ (gnus-group-find-parameter
+ gnus-newsgroup-name 'gcc-self)))
result
(groups
(cond
:type 'boolean
:group 'picons)
+(defcustom gnus-picons-group-excluded-groups nil
+ "*If this regexp matches the group name, group picons will be disabled."
+ :type 'regexp
+ :group 'picons)
+
(defcustom gnus-picons-x-face-file-name
(format "/tmp/picon-xface.%s.xbm" (user-login-name))
"The name of the file in which to store the converted X-face header."
(string))
:group 'picons)
+(defface gnus-picons-xbm-face '((t (:foreground "black" :background "white")))
+ "Face to show X face"
+ :group 'picons)
+
;;; Internal variables:
(defvar gnus-picons-processes-alist nil
(defvar gnus-article-annotations nil
"List of annotations added/removed when selecting an article")
(defvar gnus-x-face-annotations nil
- "List of annotations added/removed when selecting an article with an
-X-Face.")
+ "List of annotations added/removed when selecting an article with an X-Face.")
(defvar gnus-picons-jobs-alist nil
"List of jobs that still need be done.
(process-send-eof process))))
(defun gnus-article-display-picons ()
- "Display faces for an author and his/her domain in gnus-picons-display-where."
+ "Display faces for an author and her domain in gnus-picons-display-where."
(interactive)
(let (from at-idx)
(when (and (featurep 'xpm)
"Display icons for the group in the gnus-picons-display-where buffer."
(interactive)
(when (and (featurep 'xpm)
- (or (not (fboundp 'device-type)) (equal (device-type) 'x)))
+ (or (not (fboundp 'device-type)) (equal (device-type) 'x))
+ (or (null gnus-picons-group-excluded-groups)
+ (not (string-match gnus-picons-group-excluded-groups
+ gnus-newsgroup-name))))
(save-excursion
(gnus-picons-prepare-for-annotations 'gnus-group-annotations)
(if (null gnus-picons-piconsearch-url)
(setq gnus-group-annotations
(gnus-picons-display-pairs
- (gnus-picons-lookup-pairs (reverse (message-tokenize-header
- (gnus-group-real-name gnus-newsgroup-name)
- "."))
- gnus-picons-news-directories)
+ (gnus-picons-lookup-pairs
+ (reverse (message-tokenize-header
+ (gnus-group-real-name gnus-newsgroup-name)
+ "."))
+ gnus-picons-news-directories)
t "."))
(push (list 'gnus-group-annotations 'search nil
(message-tokenize-header
"Display picons in list PAIRS."
(let ((domain-p (and gnus-picons-display-as-address dot-p))
pair picons)
- (if (and bar-p domain-p right-p)
- (setq picons (gnus-picons-display-glyph
- (gnus-picons-try-face gnus-xmas-glyph-directory
- "bar.")
- nil right-p)))
- (while pairs
- (setq pair (pop pairs)
- picons (nconc picons
- (gnus-picons-display-picon-or-name (car pair)
- (cadr pair)
- right-p)
+ (when (and bar-p domain-p right-p)
+ (setq picons (gnus-picons-display-glyph
+ (let ((gnus-picons-file-suffixes '("xbm")))
+ (gnus-picons-try-face
+ gnus-xmas-glyph-directory "bar."))
+ nil right-p)))
+ (while (setq pair (pop pairs))
+ (setq picons (nconc picons
+ (gnus-picons-display-picon-or-name
+ (car pair) (cadr pair) right-p)
(if (and domain-p pairs)
(list (gnus-picons-make-annotation
(vector 'string :data dot-p)
nil 'text nil nil nil right-p))))))
- (if (and bar-p domain-p (not right-p))
- (setq picons (nconc picons
- (gnus-picons-display-glyph
- (gnus-picons-try-face gnus-xmas-glyph-directory
- "bar.")
- nil right-p))))
picons))
(defun gnus-picons-try-face (dir &optional filebase)
(key (concat dir filebase))
(glyph (cdr (assoc key gnus-picons-glyph-alist)))
(suffixes gnus-picons-file-suffixes)
- f)
- (while (and suffixes (null glyph))
- (when (file-exists-p (setq f (expand-file-name (concat filebase
- (pop suffixes))
- dir)))
- (setq glyph (make-glyph f))
+ f suf)
+ (while (setq suf (pop suffixes))
+ (when (file-exists-p (setq f (expand-file-name
+ (concat filebase suf)
+ dir)))
+ (setq suffixes nil
+ glyph (make-glyph f))
+ (when (equal suf "xbm")
+ (set-glyph-face glyph 'gnus-picons-xbm-face))
(push (cons key glyph) gnus-picons-glyph-alist)))
glyph))
(defun gnus-picons-display-glyph (glyph &optional part rightp)
- (let ((new (gnus-picons-make-annotation glyph (point)
- 'text nil nil nil rightp)))
+ (let ((new (gnus-picons-make-annotation
+ glyph (point) 'text nil nil nil rightp)))
(when (and part gnus-picons-display-as-address)
- (set-annotation-data new (cons new
- (make-glyph (vector 'string :data part))))
+ (set-annotation-data
+ new (cons new (make-glyph (vector 'string :data part))))
(set-annotation-action new 'gnus-picons-action-toggle))
(nconc
(list new)
(pop job)))
((eq 'bar tag)
(gnus-picons-network-display-internal
- sym-ann (gnus-picons-try-face gnus-xmas-glyph-directory
- "bar.")
+ sym-ann
+ (let ((gnus-picons-file-suffixes '("xbm")))
+ (gnus-picons-try-face
+ gnus-xmas-glyph-directory "bar."))
nil (pop job)))
((eq 'search tag);; (SYM-ANN 'search USER ADDRS DBS RIGHT-P)
(gnus-picons-network-search
(set-buffer gnus-summary-buffer)
(gnus-score-load-file
(or gnus-newsgroup-adaptive-score-file
+ (gnus-home-score-file gnus-newsgroup-name t)
(gnus-score-file-name
gnus-newsgroup-name gnus-adaptive-file-suffix))))
;; Perform ordinary line scoring.
"I" gnus-summary-increase-score
"L" gnus-summary-lower-score
"\M-i" gnus-symbolic-argument
+ "h" gnus-summary-select-article-buffer
"V" gnus-summary-score-map
"X" gnus-uu-extract-map
"t" gnus-article-hide-headers
"v" gnus-summary-verbose-headers
"m" gnus-summary-toggle-mime
- "h" gnus-article-treat-html)
+ "h" gnus-article-treat-html
+ "d" gnus-article-treat-dumbquotes)
(gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
"a" gnus-article-hide
["All of the above" gnus-article-strip-blank-lines t]
["Leading space" gnus-article-strip-leading-space t])
["Overstrike" gnus-article-treat-overstrike t]
+ ["Dumb quotes" gnus-article-treat-dumbquotes t]
["Emphasis" gnus-article-emphasize t]
["Word wrap" gnus-article-fill-cited-article t]
["CR" gnus-article-remove-cr t]
("Cache"
["Enter article" gnus-cache-enter-article t]
["Remove article" gnus-cache-remove-article t])
+ ["Select article buffer" gnus-summary-select-article-buffer t]
["Enter digest buffer" gnus-summary-enter-digest-group t]
["Isearch article..." gnus-summary-isearch-article t]
["Beginning of the article" gnus-summary-beginning-of-article t]
;; Various summary commands
+(defun gnus-summary-select-article-buffer ()
+ "Reconfigure windows to show article buffer."
+ (interactive)
+ (if (not (gnus-buffer-live-p gnus-article-buffer))
+ (error "There is no article buffer for this summary buffer")
+ (gnus-configure-windows 'article)
+ (select-window (get-buffer-window gnus-article-buffer))))
+
(defun gnus-summary-universal-argument (arg)
"Perform any operation on all articles that are process/prefixed."
(interactive "P")
(when parent
(forward-line -1)
(gnus-topic-update-topic-line
- parent (- old-unread (gnus-group-topic-unread))))
+ parent (- (or old-unread 0) (or (gnus-group-topic-unread) 0))))
unread))
(defun gnus-topic-group-indentation ()
"Run when changing levels to enter/remove groups from topics."
(save-excursion
(set-buffer gnus-group-buffer)
- (gnus-group-goto-group (or (car (nth 2 previous)) group))
- (when (and gnus-topic-mode
- gnus-topic-alist
- (not gnus-topic-inhibit-change-level))
- ;; Remove the group from the topics.
- (when (and (< oldlevel gnus-level-zombie)
+ (unless gnus-topic-inhibit-change-level
+ (gnus-group-goto-group (or (car (nth 2 previous)) group))
+ (when (and gnus-topic-mode
+ gnus-topic-alist
+ (not gnus-topic-inhibit-change-level))
+ ;; Remove the group from the topics.
+ (if (and (< oldlevel gnus-level-zombie)
(>= level gnus-level-zombie))
- (let (alist)
- (forward-line -1)
- (when (setq alist (assoc (gnus-current-topic) gnus-topic-alist))
- (setcdr alist (gnus-delete-first group (cdr alist))))))
- ;; If the group is subscribed we enter it into the topics.
- (when (and (< level gnus-level-zombie)
- (>= oldlevel gnus-level-zombie))
- (let* ((prev (gnus-group-group-name))
- (gnus-topic-inhibit-change-level t)
- (gnus-group-indentation
- (make-string
- (* gnus-topic-indent-level
- (or (save-excursion
- (gnus-topic-goto-topic (gnus-current-topic))
- (gnus-group-topic-level))
- 0))
- ? ))
- (yanked (list group))
- alist talist end)
- ;; Then we enter the yanked groups into the topics they belong
- ;; to.
- (when (setq alist (assoc (save-excursion
- (forward-line -1)
- (or
- (gnus-current-topic)
- (caar gnus-topic-topology)))
- gnus-topic-alist))
- (setq talist alist)
- (when (stringp yanked)
- (setq yanked (list yanked)))
- (if (not prev)
- (nconc alist yanked)
- (if (not (cdr alist))
- (setcdr alist (nconc yanked (cdr alist)))
- (while (and (not end) (cdr alist))
- (when (equal (cadr alist) prev)
- (setcdr alist (nconc yanked (cdr alist)))
- (setq end t))
- (setq alist (cdr alist)))
- (unless end
- (nconc talist yanked))))))
- (gnus-topic-update-topic)))))
+ (let ((alist gnus-topic-alist))
+ (while (gnus-group-goto-group group)
+ (gnus-delete-line))
+ (while alist
+ (when (member group (car alist))
+ (setcdr (car alist) (delete group (cdar alist))))
+ (pop alist)))
+ ;; If the group is subscribed we enter it into the topics.
+ (when (and (< level gnus-level-zombie)
+ (>= oldlevel gnus-level-zombie))
+ (let* ((prev (gnus-group-group-name))
+ (gnus-topic-inhibit-change-level t)
+ (gnus-group-indentation
+ (make-string
+ (* gnus-topic-indent-level
+ (or (save-excursion
+ (gnus-topic-goto-topic (gnus-current-topic))
+ (gnus-group-topic-level))
+ 0))
+ ? ))
+ (yanked (list group))
+ alist talist end)
+ ;; Then we enter the yanked groups into the topics they belong
+ ;; to.
+ (when (setq alist (assoc (save-excursion
+ (forward-line -1)
+ (or
+ (gnus-current-topic)
+ (caar gnus-topic-topology)))
+ gnus-topic-alist))
+ (setq talist alist)
+ (when (stringp yanked)
+ (setq yanked (list yanked)))
+ (if (not prev)
+ (nconc alist yanked)
+ (if (not (cdr alist))
+ (setcdr alist (nconc yanked (cdr alist)))
+ (while (and (not end) (cdr alist))
+ (when (equal (cadr alist) prev)
+ (setcdr alist (nconc yanked (cdr alist)))
+ (setq end t))
+ (setq alist (cdr alist)))
+ (unless end
+ (nconc talist yanked))))))
+ (gnus-topic-update-topic)))))))
(defun gnus-topic-goto-next-group (group props)
"Go to group or the next group after group."
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "0.12"
+(defconst gnus-version-number "0.13"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Quassia Gnus v%s" gnus-version-number)
set-face-stipple mail-abbrevs-setup char-int
make-char-table set-char-table-range font-create-object
x-color-values widget-make-intangible error-message-string
- w3-form-encode-xwfu
- ))
+ w3-form-encode-xwfu md5))
(maybe-bind '(global-face-data
mark-active transient-mark-mode mouse-selection-click-count
mouse-selection-click-count-buffer buffer-display-table
font-lock-defaults user-full-name user-login-name
- gnus-newsgroup-name gnus-article-x-face-too-ugly)))
+ gnus-newsgroup-name gnus-article-x-face-too-ugly
+ mail-mode-hook)))
(defvar browse-url-browser-function nil)
(maybe-fbind '(color-instance-rgb-components
make-color-instance color-instance-name specifier-instance
;;; Code: ---------------------------------------------------------------------
-(defvar md5-program "md5"
+(defvar md5-program "md5sum"
"*Program that reads a message on its standard input and writes an
MD5 digest on its output.")
(string-match "\\." mail-host-address))
mail-host-address)
;; We try `user-mail-address' as a backup.
- ((and (string-match "\\." user-mail)
+ ((and user-mail
+ (string-match "\\." user-mail)
(string-match "@\\(.*\\)\\'" user-mail))
(match-string 1 user-mail))
;; Default to this bogus thing.
--- /dev/null
+;;; nnlsitserv.el --- retrieving articles via web mailing list archives
+;; Copyright (C) 1997 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news, mail
+
+;; 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:
+
+;; Note: You need to have `url' and `w3' installed for this
+;; backend to work.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(push '("nnlistserv" none) gnus-valid-select-methods)
+
+(require 'nnoo)
+(require 'nnweb)
+
+(nnoo-declare nnlistserv
+ nnweb)
+
+(defvoo nnlistserv-directory (nnheader-concat gnus-directory "nnlistserv/")
+ "Where nnlistserv will save its files."
+ nnweb-directory)
+
+(defvoo nnlistserv-name 'kk
+ "What search engine type is being used."
+ nnweb-type)
+
+(defvoo nnlistserv-type-definition
+ '((kk
+ (article . nnlistserv-kk-wash-article)
+ (map . nnlistserv-kk-create-mapping)
+ (search . nnlistserv-kk-search)
+ (address . "http://www.itk.ntnu.no/ansatte/Andresen_Trond/kk-f/%s/")
+ (pages "fra160396" "fra160796" "fra061196" "fra160197"
+ "fra090997" "fra040797" "fra130397" "nye")
+ (index . "date.html")
+ (identifier . nnlistserv-kk-identity)))
+ "Type-definition alist."
+ nnweb-type-definition)
+
+(defvoo nnlistserv-search nil
+ "Search string to feed to DejaNews."
+ nnweb-search)
+
+(defvoo nnlistserv-ephemeral-p nil
+ "Whether this nnlistserv server is ephemeral."
+ nnweb-ephemeral-p)
+
+;;; Internal variables
+
+;;; Interface functions
+
+(nnoo-define-basics nnlistserv)
+
+(nnoo-import nnlistserv
+ (nnweb))
+
+;;; Internal functions
+
+;;;
+;;; KK functions.
+;;;
+
+(defun nnlistserv-kk-create-mapping ()
+ "Perform the search and create an number-to-url alist."
+ (save-excursion
+ (set-buffer nnweb-buffer)
+ (let ((case-fold-search t)
+ (active (or (cadr (assoc nnweb-group nnweb-group-alist))
+ (cons 1 0)))
+ (pages (nnweb-definition 'pages))
+ map url page subject from )
+ (while (setq page (pop pages))
+ (erase-buffer)
+ (when (funcall (nnweb-definition 'search) page)
+ ;; Go through all the article hits on this page.
+ (goto-char (point-min))
+ (nnweb-decode-entities)
+ (goto-char (point-min))
+ (while (re-search-forward "^<li> *<a href=\"\\([^\"]+\\)\"><b>\\([^\\>]+\\)</b></a> *<[^>]+><i>\\([^>]+\\)<" nil t)
+ (setq url (match-string 1)
+ subject (match-string 2)
+ from (match-string 3))
+ (setq url (concat (format (nnweb-definition 'address) page) url))
+ (unless (nnweb-get-hashtb url)
+ (push
+ (list
+ (incf (cdr active))
+ (make-full-mail-header
+ (cdr active) subject from ""
+ (concat "<" (nnweb-identifier url) "@kk>")
+ nil 0 0 url))
+ map)
+ (nnweb-set-hashtb (cadar map) (car map))
+ (message "%s %s %s" (cdr active) (point) pages)
+ ))))
+ ;; Return the articles in the right order.
+ (setq nnweb-articles
+ (sort (nconc nnweb-articles map) 'car-less-than-car)))))
+
+(defun nnlistserv-kk-wash-article ()
+ (let ((case-fold-search t)
+ (headers '(sent name email subject id))
+ sent name email subject id)
+ (nnweb-decode-entities)
+ (while headers
+ (goto-char (point-min))
+ (re-search-forward (format "<!-- %s=\"\\([^\"]+\\)" (car headers) nil t))
+ (set (pop headers) (match-string 1)))
+ (goto-char (point-min))
+ (search-forward "<!-- body" nil t)
+ (delete-region (point-min) (progn (forward-line 1) (point)))
+ (goto-char (point-max))
+ (search-backward "<!-- body" nil t)
+ (delete-region (point-max) (progn (beginning-of-line) (point)))
+ (nnweb-remove-markup)
+ (goto-char (point-min))
+ (insert (format "From: %s <%s>\n" name email)
+ (format "Subject: %s\n" subject)
+ (format "Message-ID: %s\n" id)
+ (format "Date: %s\n\n" sent))))
+
+(defun nnlistserv-kk-search (search)
+ (url-insert-file-contents
+ (concat (format (nnweb-definition 'address) search)
+ (nnweb-definition 'index)))
+ t)
+
+(defun nnlistserv-kk-identity (url)
+ "Return an unique identifier based on URL."
+ url)
+
+(provide 'nnlistserv)
+
+;;; nnlistserv.el ends here
;;; Utility functions
-;; Written by byer@mv.us.adobe.com (Scott Byer).
(defun nnmail-make-complex-temp-name (prefix)
(let ((newname (make-temp-name prefix))
(newprefix prefix))
(defvoo nnweb-type 'dejanews
"What search engine type is being used.")
-(defvar nnweb-type-definition
+(defvoo nnweb-type-definition
'((dejanews
(article . nnweb-dejanews-wash-article)
(map . nnweb-dejanews-create-mapping)
("ageweight" . "1")))
t)
+(defun nnweb-dejanewsold-search (search)
+ (nnweb-fetch-form
+ (nnweb-definition 'address)
+ `(("query" . ,search)
+ ("defaultOp" . "AND")
+ ("svcclass" . "dnold")
+ ("maxhits" . "100")
+ ("format" . "verbose")
+ ("threaded" . "0")
+ ("showsort" . "score")
+ ("agesign" . "1")
+ ("ageweight" . "1")))
+ t)
+
(defun nnweb-dejanews-identity (url)
"Return an unique identifier based on URL."
(if (string-match "recnum=\\([0-9]+\\)" url)
;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
;; Keywords: mail, pop3
-;; Version: 1.3g
+;; Version: 1.3h
;; This file is part of GNU Emacs.
(require 'mail-utils)
(provide 'pop3)
-(defconst pop3-version "1.3g")
+(defconst pop3-version "1.3h")
(defvar pop3-maildrop (or user-login-name (getenv "LOGNAME") (getenv "USER") nil)
"*POP3 maildrop.")
"Timestamp returned when initially connected to the POP server.
Used for APOP authentication.")
-(defvar pop3-movemail-file-coding-system nil
- "Crashbox made by pop3-movemail with this coding system.")
-
(defvar pop3-read-point nil)
(defvar pop3-debug nil)
(let* ((process (pop3-open-server pop3-mailhost pop3-port))
(crashbuf (get-buffer-create " *pop3-retr*"))
(n 1)
- message-count)
+ message-count
+ (pop3-password pop3-password)
+ )
;; for debugging only
(if pop3-debug (switch-to-buffer (process-buffer process)))
+ ;; query for password
+ (if (and pop3-password-required (not pop3-password))
+ (setq pop3-password
+ (pop3-read-passwd (format "Password for %s: " pop3-maildrop))))
(cond ((equal 'apop pop3-authentication-scheme)
(pop3-apop process pop3-maildrop))
((equal 'pass pop3-authentication-scheme)
(pop3-retr process n crashbuf)
(save-excursion
(set-buffer crashbuf)
- (let ((coding-system-for-write pop3-movemail-file-coding-system))
- (append-to-file (point-min) (point-max) crashbox))
+ (append-to-file (point-min) (point-max) crashbox)
(set-buffer (process-buffer process))
(while (> (buffer-size) 5000)
(goto-char (point-min))
(defun pop3-pass (process)
"Send authentication information to the server."
- (let ((pass pop3-password))
- (if (and pop3-password-required (not pass))
- (setq pass
- (pop3-read-passwd (format "Password for %s: " pop3-maildrop))))
- (if pass
- (progn
- (pop3-send-command process (format "PASS %s" pass))
- (let ((response (pop3-read-response process t)))
- (if (not (and response (string-match "+OK" response)))
- (pop3-quit process)))))
- ))
-
-(defvar pop3-md5-program "md5"
- "*Program to encode its input in MD5.")
-
-(defun pop3-md5 (string)
- (nnheader-temp-write nil
- (insert string)
- (call-process-region (point-min) (point-max)
- (or shell-file-name "/bin/sh")
- t (current-buffer) nil
- "-c" pop3-md5-program)
- ;; The meaningful output is the first 32 characters.
- ;; Don't return the newline that follows them!
- (buffer-substring (point-min) (+ (point-min) 32))))
+ (pop3-send-command process (format "PASS %s" pop3-password))
+ (let ((response (pop3-read-response process t)))
+ (if (not (and response (string-match "+OK" response)))
+ (pop3-quit process))))
(defun pop3-apop (process user)
"Send alternate authentication information to the server."
- (let ((pass pop3-password))
- (if (and pop3-password-required (not pass))
- (setq pass
- (pop3-read-passwd (format "Password for %s: " pop3-maildrop))))
- (if pass
- (let ((hash (pop3-md5 (concat pop3-timestamp pass))))
- (pop3-send-command process (format "APOP %s %s" user hash))
- (let ((response (pop3-read-response process t)))
- (if (not (and response (string-match "+OK" response)))
- (pop3-quit process)))))
- ))
+ (if (not (fboundp 'md5)) (autoload 'md5 "md5"))
+ (let ((hash (md5 (concat pop3-timestamp pop3-password))))
+ (pop3-send-command process (format "APOP %s %s" user hash))
+ (let ((response (pop3-read-response process t)))
+ (if (not (and response (string-match "+OK" response)))
+ (pop3-quit process)))))
;; TRANSACTION STATE
+Mon Oct 13 00:08:06 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Agent Commands): Addition.
+
+Sun Oct 12 16:50:23 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Article Washing): Addition.
+ (Group Highlighting): New.
+ (Canceling and Superseding): Addition.
+
Wed Oct 1 18:37:55 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
* gnus.texi (Startup Files): Addition.
background is dark:
@lisp
+(face-spec-set 'my-group-face-1 '((t (:foreground "Red" :bold t))))
+(face-spec-set 'my-group-face-2 '((t (:foreground "SeaGreen" :bold t))))
+(face-spec-set 'my-group-face-3 '((t (:foreground "SpringGreen" :bold t))))
+(face-spec-set 'my-group-face-4 '((t (:foreground "SteelBlue" :bold t))))
+(face-spec-set 'my-group-face-5 '((t (:foreground "SkyBlue" :bold t))))
+
+(setq gnus-group-highlight
+ '(((> unread 200) . my-group-face-1)
+ ((and (< level 3) (zerop unread)) . my-group-face-2)
+ ((< level 3) . my-group-face-3)
+ ((zerop unread) . my-group-face-4)
(setq gnus-group-highlight
`(((> unread 200) .
,(custom-face-lookup "Red" nil nil t nil nil))
,(custom-face-lookup "SteelBlue" nil nil t nil nil))
(t .
,(custom-face-lookup "SkyBlue" nil nil t nil nil))))
+ (t . my-group-face-5)))
@end lisp
Variables that are dynamically bound when the forms are evaluated
@kindex s (Summary)
@findex gnus-summary-isearch-article
Perform an isearch in the article buffer
-(@code{gnus-summary-isearch-article}).
+(@code{gnus-summary-isearch-article}).
+
+@item h
+@kindex h (Summary)
+@findex gnus-summary-select-article-buffer
+Select the article buffer (@code{gnus-summary-select-article-buffer}).
@end table
Find the article you wish to cancel (you can only cancel your own
articles, so don't try any funny stuff). Then press @kbd{C} or @kbd{S
c} (@code{gnus-summary-cancel-article}). Your article will be
-canceled---machines all over the world will be deleting your article.
+canceled---machines all over the world will be deleting your article.
+This command uses the process/prefix convention (@pxref{Process/Prefix}).
Be aware, however, that not all sites honor cancels, so your article may
live on here and there, while most sites will delete the article in
question.
+Gnus will use the ``current'' select method when cancelling. If you
+want to use the standard posting method, use the @samp{a} symbolic
+prefix (@pxref{Symbolic Prefixes}).
+
If you discover that you have made some mistakes and want to do some
corrections, you can post a @dfn{superseding} article that will replace
your original article.
commands have is to remove a few (or many) articles from the summary
buffer.
+All limiting commands work on subsets of the articles already fetched
+from the servers. None of these commands query the server for
+additional articles.
+
@table @kbd
@item / /
@findex gnus-article-treat-overstrike
Treat overstrike (@code{gnus-article-treat-overstrike}).
+@item W d
+@kindex W d (Summary)
+@findex gnus-article-treat-dumbquotes
+Treat M******** sm*rtq**t*s (@code{gnus-article-treat-dumbquotes}).
+
@item W w
@kindex W w (Summary)
@findex gnus-article-fill-cited-article
old.
@item long-to
Remove the @code{To} header if it is very long.
+@item many-to
+Remove all @code{To} headers if there are more than one.
@end table
To include the four first elements, you could say something like;
@node Composing Messages
@chapter Composing Messages
+@cindex composing messages
+@cindex messages
+@cindex mail
+@cindex sending mail
@cindex reply
@cindex followup
@cindex post
connection before giving up. If it is @code{nil}, which is the default,
no timeouts are done.
-@item nntp-command-timeout
-@vindex nntp-command-timeout
-@cindex PPP connections
-@cindex dynamic IP addresses
-If you're running Gnus on a machine that has a dynamically assigned
-address, Gnus may become confused. If the address of your machine
-changes after connecting to the @sc{nntp} server, Gnus will simply sit
-waiting forever for replies from the server. To help with this
-unfortunate problem, you can set this command to a number. Gnus will
-then, if it sits waiting for a reply from the server longer than that
-number of seconds, shut down the connection, start a new one, and resend
-the command. This should hopefully be transparent to the user. A
-likely number is 30 seconds.
-
-@item nntp-retry-on-break
-@vindex nntp-retry-on-break
-If this variable is non-@code{nil}, you can also @kbd{C-g} if Gnus
-hangs. This will have much the same effect as the command timeout
-described above.
+@c @item nntp-command-timeout
+@c @vindex nntp-command-timeout
+@c @cindex PPP connections
+@c @cindex dynamic IP addresses
+@c If you're running Gnus on a machine that has a dynamically assigned
+@c address, Gnus may become confused. If the address of your machine
+@c changes after connecting to the @sc{nntp} server, Gnus will simply sit
+@c waiting forever for replies from the server. To help with this
+@c unfortunate problem, you can set this command to a number. Gnus will
+@c then, if it sits waiting for a reply from the server longer than that
+@c number of seconds, shut down the connection, start a new one, and resend
+@c the command. This should hopefully be transparent to the user. A
+@c likely number is 30 seconds.
+@c
+@c @item nntp-retry-on-break
+@c @vindex nntp-retry-on-break
+@c If this variable is non-@code{nil}, you can also @kbd{C-g} if Gnus
+@c hangs. This will have much the same effect as the command timeout
+@c described above.
@item nntp-server-hook
@vindex nntp-server-hook
@item nnweb-type
@vindex nnweb-type
What search engine type is being used. The currently supported types
-are @code{dejanews}, @code{altavista} and @code{reference}.
+are @code{dejanews}, @code{dejanewsold}, @code{altavista} and
+@code{reference}.
@item nnweb-search
@vindex nnweb-search
* Server Agent Commands::
@end menu
+You can run a complete batch fetch from the command line with the
+following incantation:
+
+@cindex gnus-agent-batch-fetch
+@example
+$ emacs -batch -l ~/.gnus.el -f gnus-agent-batch-fetch
+@end example
+
+
@node Group Agent Commands
@subsubsection Group Agent Commands
buffer visible using the standard Gnus window configuration
routines---@pxref{Windows Configuration}.
+@item gnus-picons-group-excluded-groups
+@vindex gnus-picons-group-excluded-groups
+Groups that are matched by this regexp won't have their group icons
+displayed.
+
@end table
@iftex
projects / elisp / gnus.git- / commitdiff