From ba4ccbdba95e2c1740fae6c4752c4373951a9e19 Mon Sep 17 00:00:00 2001 From: Lars Magne Ingebrigtsen Date: Tue, 4 Mar 1997 04:05:34 +0000 Subject: [PATCH] *** empty log message *** --- lisp/ChangeLog | 15 +++++++ lisp/gnus-msg.el | 6 ++- lisp/gnus-vis.el | 43 ++------------------ lisp/gnus.el | 100 ++++++++++++++++++++++++++--------------------- lisp/nnkiboze.el | 4 +- lisp/nntp.el | 52 +++++++++++++----------- 6 files changed, 111 insertions(+), 109 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 8f169f17a..56b425ffa 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,18 @@ +Tue Dec 5 04:05:27 1995 Lars Magne Ingebrigtsen + + * gnus.el (gnus-summary-set-process-mark): Make sure each article + is only process-marked once. + (gnus-summary-sort-by-author): Also allow sorting of + pseudo-articles. + (gnus-summary-sort-by-subject): Ditto. + +Sat Nov 18 03:09:37 1995 Lars Magne Ingebrigtsen + + * nntp.el (nntp-open-server): Accept a second optional parameter + for just changing virtual server. Doc fix. + (nntp-possibly-change-server): Use it. + (nntp-close-server): Ditto. + Fri Nov 3 03:16:04 1995 Lars Magne Ingebrigtsen * gnus.el (gnus-summary-refer-article): Would mark oddly. diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 89d4c3e98..018ec0d60 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -1328,8 +1328,10 @@ domain is undefined, the domain name is got from it." (t domain))) (if (string-match "\\." (system-name)) (system-name) - (substring user-mail-address - (1+ (string-match "@" user-mail-address)))))) + (if (string-match "@\\([^ ]+\\)\\($\\| \\)" user-mail-address) + (substring user-mail-address + (match-beginning 1) (match-end 1)) + "bogus-domain")))) (defun gnus-inews-full-address () (let ((domain (gnus-inews-domain-name)) diff --git a/lisp/gnus-vis.el b/lisp/gnus-vis.el index 7577dd22e..138985615 100644 --- a/lisp/gnus-vis.el +++ b/lisp/gnus-vis.el @@ -29,6 +29,7 @@ (require 'gnus-ems) (require 'easymenu) (require 'custom) +(require 'browse-url) (defvar gnus-group-menu-hook nil "*Hook run after the creation of the group mode menu.") @@ -216,10 +217,10 @@ gnus-cite-attribution-alist) gnus-button-message-id 3) ;; This is how URLs _should_ be embedded in text... - ("]*\\)>" 0 t gnus-button-url 1) + ("]*\\)>" 0 t browse-url-browser-function 1) ;; Next regexp stolen from highlight-headers.el. ;; Modified by Vladimir Alexiev. - ("\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*[-a-zA-Z0-9_=#$@~`%&*+|\\/]" 0 t gnus-button-url 0)) + ("\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*[-a-zA-Z0-9_=#$@~`%&*+|\\/]" 0 t browse-url-browser-function 0)) "Alist of regexps matching buttons in an article. Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where @@ -233,26 +234,6 @@ PAR: is a number of a regexp grouping whose text will be passed to CALLBACK. CALLBACK can also be a variable, in that case the value of that variable it the real callback function.") -;see gnus-cus.el -;(eval-when-compile -; (defvar browse-url-browser-function)) - -;see gnus-cus.el -;(defvar gnus-button-url -; (cond ((boundp 'browse-url-browser-function) browse-url-browser-function) -; ((fboundp 'w3-fetch) 'w3-fetch) -; ((eq window-system 'x) 'gnus-netscape-open-url)) -; "*Function to fetch URL. -;The function will be called with one argument, the URL to fetch. -;Useful values of this function are: - -;w3-fetch: -; defined in the w3 emacs package by William M. Perry. -;gnus-netscape-open-url: -; open url in existing netscape, start netscape if none found. -;gnus-netscape-start-url: -; start new netscape with url.") - (eval-and-compile @@ -1248,7 +1229,7 @@ to do the hiding. See the documentation for those functions." (skip-chars-forward ": \t") (let ((from (point))) (goto-char end) - (skip-chars-backward " \t") + (skip-chars-backward " \t\n") (put-text-property from (point) 'face field-face) (setq field-found t)))))) (goto-char begin))))))) @@ -1317,22 +1298,6 @@ External references are things like message-ids and URLs, as specified by (gnus-article-add-button start end 'gnus-button-push (set-marker (make-marker) from))))))))) -(defun gnus-netscape-open-url (url) - "Open URL in netscape, or start new scape with URL." - (let ((process (start-process (concat "netscape " url) - nil - "netscape" - "-remote" - (concat "openUrl(" url ")'")))) - (set-process-sentinel process - (` (lambda (process change) - (or (eq (process-exit-status process) 0) - (gnus-netscape-start-url (, url)))))))) - -(defun gnus-netscape-start-url (url) - "Start netscape with URL." - (start-process (concat "netscape" url) nil "netscape" url)) - ;;; External functions: (defun gnus-article-add-button (from to fun &optional data) diff --git a/lisp/gnus.el b/lisp/gnus.el index 90dd34373..a24c0d251 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -1194,6 +1194,9 @@ following hook: It is meant to be used for highlighting the article in some way. It is not run if `gnus-visual' is nil.") +(defun gnus-parse-headers-hook nil + "*A hook called before parsing the headers.") + (defvar gnus-exit-group-hook nil "*A hook called when exiting (not quitting) summary mode.") @@ -1349,7 +1352,7 @@ variable (string, integer, character, etc).") "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") -(defconst gnus-version "Gnus v5.0.12" +(defconst gnus-version "Gnus v5.0.13" "Version number for this version of Gnus.") (defvar gnus-info-nodes @@ -2837,7 +2840,17 @@ that that variable is buffer-local to the summary buffers." (defun gnus-group-quit-config (group) "Return the quit-config of GROUP." - (cdr (assoc 'quit-config (gnus-find-method-for-group group)))) + (nth 1 (assoc 'quit-config (gnus-find-method-for-group group)))) + +(defun gnus-simplify-mode-line () + "Make mode lines a bit simpler." + (setq mode-line-modified "-- ") + (if (listp mode-line-format) + (progn + (make-local-variable 'mode-line-format) + (setq mode-line-format (copy-sequence mode-line-format)) + (and (equal (nth 3 mode-line-format) " ") + (setcar (nthcdr 3 mode-line-format) ""))))) ;;; List and range functions @@ -3075,6 +3088,7 @@ Note: LIST has to be sorted over `<'." (defvar gnus-group-group-map nil) (defvar gnus-group-mark-map nil) (defvar gnus-group-list-map nil) +(defvar gnus-group-help-map nil) (defvar gnus-group-sub-map nil) (put 'gnus-group-mode 'mode-class 'special) @@ -3131,7 +3145,6 @@ Note: LIST has to be sorted over `<'." (define-key gnus-group-mode-map "Z" 'gnus-group-clear-dribble) (define-key gnus-group-mode-map "q" 'gnus-group-exit) (define-key gnus-group-mode-map "Q" 'gnus-group-quit) - (define-key gnus-group-mode-map "\M-f" 'gnus-group-fetch-faq) (define-key gnus-group-mode-map "?" 'gnus-group-describe-briefly) (define-key gnus-group-mode-map "\C-c\C-i" 'gnus-info-find-node) (define-key gnus-group-mode-map "\M-e" 'gnus-group-edit-group-method) @@ -3181,6 +3194,10 @@ Note: LIST has to be sorted over `<'." (define-key gnus-group-list-map "m" 'gnus-group-list-matching) (define-key gnus-group-list-map "M" 'gnus-group-list-all-matching) + (define-prefix-command 'gnus-group-help-map) + (define-key gnus-group-mode-map "H" 'gnus-group-help-map) + (define-key gnus-group-help-map "f" 'gnus-group-fetch-faq) + (define-prefix-command 'gnus-group-sub-map) (define-key gnus-group-mode-map "S" 'gnus-group-sub-map) (define-key gnus-group-sub-map "l" 'gnus-group-set-current-level) @@ -3211,11 +3228,7 @@ The following commands are available: (interactive) (if gnus-visual (gnus-group-make-menu-bar)) (kill-all-local-variables) - (setq mode-line-modified "-- ") - (make-local-variable 'mode-line-format) - (setq mode-line-format (copy-sequence mode-line-format)) - (and (equal (nth 3 mode-line-format) " ") - (setcar (nthcdr 3 mode-line-format) "")) + (gnus-simplify-mode-line) (setq major-mode 'gnus-group-mode) (setq mode-name "Group") (gnus-group-set-mode-line) @@ -5150,11 +5163,7 @@ buffer. (interactive) (kill-all-local-variables) (if gnus-visual (gnus-browse-make-menu-bar)) - (setq mode-line-modified "-- ") - (make-local-variable 'mode-line-format) - (setq mode-line-format (copy-sequence mode-line-format)) - (and (equal (nth 3 mode-line-format) " ") - (setcar (nthcdr 3 mode-line-format) "")) + (gnus-simplify-mode-line) (setq major-mode 'gnus-browse-mode) (setq mode-name "Browse Server") (setq mode-line-process nil) @@ -5635,11 +5644,7 @@ The following commands are available: (set (car locals) nil)) (setq locals (cdr locals)))) (gnus-make-thread-indent-array) - (setq mode-line-modified "-- ") - (make-local-variable 'mode-line-format) - (setq mode-line-format (copy-sequence mode-line-format)) - (and (equal (nth 3 mode-line-format) " ") - (setcar (nthcdr 3 mode-line-format) "")) + (gnus-simplify-mode-line) (setq major-mode 'gnus-summary-mode) (setq mode-name "Summary") (make-local-variable 'minor-mode-alist) @@ -7175,6 +7180,8 @@ The resulting hash table is returned, or nil if no Xrefs were found." headers id dep end ref) (save-excursion (set-buffer nntp-server-buffer) + ;; Allow the user to mangle the headers before parsing them. + (run-hooks 'gnus-parse-headers-hook) (goto-char (point-min)) ;; Search to the beginning of the next header. Error messages ;; do not begin with 2 or 3. @@ -7312,6 +7319,8 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')." number headers header) (save-excursion (set-buffer nntp-server-buffer) + ;; Allow the user to mangle the headers before parsing them. + (run-hooks 'gnus-parse-headers-hook) (goto-char (point-min)) (while (and sequence (not (eobp))) (setq number (read cur)) @@ -8959,7 +8968,7 @@ functions. (Ie. mail newsgroups at present.)" (gnus-request-article-this-buffer (car articles) gnus-newsgroup-name) (gnus-request-accept-article - (if select-method (quote select-method) to-newsgroup) + (if select-method (list 'quote select-method) to-newsgroup) (not (cdr articles))))) (let* ((entry (or @@ -9431,7 +9440,9 @@ the actual number of articles marked is returned." (defun gnus-summary-set-process-mark (article) "Set the process mark on ARTICLE and update the summary line." - (setq gnus-newsgroup-processable (cons article gnus-newsgroup-processable)) + (setq gnus-newsgroup-processable + (cons article + (delq article gnus-newsgroup-processable))) (let ((buffer-read-only nil)) (if (gnus-summary-goto-subject article) (progn @@ -9757,7 +9768,10 @@ even ticked and dormant ones." ;; Fix by Sudish Joseph . (gnus-set-global-variables) (let ((buffer-read-only nil) - (orig-article (gnus-summary-article-number)) + (orig-article + (progn + (gnus-summary-search-forward t) + (gnus-summary-article-number))) (marks (concat "^[" marks "]"))) (goto-char (point-min)) (if gnus-newsgroup-adaptive @@ -10231,12 +10245,14 @@ Argument REVERSE means reverse order." (cons (lambda () (let* ((header (gnus-get-header-by-num (gnus-summary-article-number))) - (extract (funcall - gnus-extract-address-components - (mail-header-from header)))) - (concat (or (car extract) (cdr extract)) - "\r" (int-to-string (mail-header-number header)) - "\r" (mail-header-subject header)))) + extract) + (if (not (vectorp header)) + "" + (setq extract (funcall gnus-extract-address-components + (mail-header-from header))) + (concat (or (car extract) (cdr extract)) + "\r" (int-to-string (mail-header-number header)) + "\r" (mail-header-subject header))))) 'gnus-thread-sort-by-author) reverse)) @@ -10250,13 +10266,15 @@ Argument REVERSE means reverse order." (cons (lambda () (let* ((header (gnus-get-header-by-num (gnus-summary-article-number))) - (extract (funcall - gnus-extract-address-components - (mail-header-from header)))) - (concat - (downcase (gnus-simplify-subject (gnus-summary-subject-string) t)) - "\r" (int-to-string (mail-header-number header)) - "\r" (or (car extract) (cdr extract))))) + extract) + (if (not (vectorp header)) + "" + (setq extract (funcall gnus-extract-address-components + (mail-header-from header))) + (concat + (downcase (gnus-simplify-subject (gnus-summary-subject-string) t)) + "\r" (int-to-string (mail-header-number header)) + "\r" (or (car extract) (cdr extract)))))) 'gnus-thread-sort-by-subject) reverse)) @@ -10748,11 +10766,7 @@ The following commands are available: (interactive) (if gnus-visual (gnus-article-make-menu-bar)) (kill-all-local-variables) - (setq mode-line-modified "-- ") - (make-local-variable 'mode-line-format) - (setq mode-line-format (copy-sequence mode-line-format)) - (and (equal (nth 3 mode-line-format) " ") - (setcar (nthcdr 3 mode-line-format) "")) + (gnus-simplify-mode-line) (setq mode-name "Article") (setq major-mode 'gnus-article-mode) (make-local-variable 'minor-mode-alist) @@ -12057,7 +12071,7 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." ;; Find new newsgroups and treat them. (if (and init gnus-check-new-newsgroups gnus-read-active-file (not level) - (gnus-server-opened gnus-select-method)) + (gnus-check-server gnus-select-method)) (gnus-find-new-newsgroups)) ;; Find the number of unread articles in each non-dead group. @@ -13596,11 +13610,7 @@ The following commands are available: (interactive) (if gnus-visual (gnus-server-make-menu-bar)) (kill-all-local-variables) - (setq mode-line-modified "-- ") - (make-local-variable 'mode-line-format) - (setq mode-line-format (copy-sequence mode-line-format)) - (and (equal (nth 3 mode-line-format) " ") - (setcar (nthcdr 3 mode-line-format) "")) + (gnus-simplify-mode-line) (setq major-mode 'gnus-server-mode) (setq mode-name "Server") ; (gnus-group-set-mode-line) diff --git a/lisp/nnkiboze.el b/lisp/nnkiboze.el index 65b67432e..8390c421b 100644 --- a/lisp/nnkiboze.el +++ b/lisp/nnkiboze.el @@ -149,7 +149,8 @@ If the stream is opened, return T, otherwise return NIL." () (save-excursion (let ((unreads gnus-newsgroup-unreads) - (unselected gnus-newsgroup-unselected)) + (unselected gnus-newsgroup-unselected) + (version-control 'never)) (set-buffer (get-buffer-create "*nnkiboze work*")) (buffer-disable-undo (current-buffer)) (erase-buffer) @@ -222,6 +223,7 @@ Finds out what articles are to be part of the nnkiboze groups." (regexp (nth 1 (nth 4 info))) (gnus-expert-user t) (gnus-large-newsgroup nil) + (version-control 'never) (gnus-score-find-score-files-function 'nnkiboze-score-file) gnus-select-group-hook gnus-summary-prepare-hook gnus-thread-sort-functions gnus-show-threads diff --git a/lisp/nntp.el b/lisp/nntp.el index 3498a33be..832fb5e89 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -334,7 +334,10 @@ instead call function `nntp-status-message' to get status message.") 'active) 'group)))) -(defun nntp-open-server (server &optional defs) +(defun nntp-open-server (server &optional defs connectionless) + "Open the virtual server SERVER. +If CONNECTIONLESS is non-nil, don't attempt to connect to any physical +servers." (nnheader-init-server-buffer) (if (nntp-server-opened server) t @@ -356,16 +359,20 @@ instead call function `nntp-status-message' to get status message.") (setq nntp-server-alist (delq state nntp-server-alist))) (nnheader-set-init-variables nntp-server-variables defs))) (setq nntp-current-server server) - (or (nntp-server-opened server) - (progn - (if (member nntp-address nntp-timeout-servers) - nil - (run-hooks 'nntp-prepare-server-hook) - (nntp-open-server-semi-internal nntp-address nntp-port-number)))))) + ;; We have now changed to the proper virtual server. We then + ;; check that the physical server is opened. + (if (or (nntp-server-opened server) + connectionless) + () + (if (member nntp-address nntp-timeout-servers) + nil + ;; We open a connection to the physical nntp server. + (run-hooks 'nntp-prepare-server-hook) + (nntp-open-server-semi-internal nntp-address nntp-port-number))))) (defun nntp-close-server (&optional server) "Close connection to SERVER." - (nntp-possibly-change-server nil server) + (nntp-possibly-change-server nil server t) (unwind-protect (progn ;; Un-set default sentinel function before closing connection. @@ -525,10 +532,10 @@ instead call function `nntp-status-message' to get status message.") (defun nntp-request-group-description (group &optional server) "Get description of GROUP." - (if (nntp-possibly-change-server nil server) - (prog1 - (nntp-send-command "^.*\r?\n" "XGTITLE" group) - (nntp-decode-text)))) + (nntp-possibly-change-server nil server) + (prog1 + (nntp-send-command "^.*\r?\n" "XGTITLE" group) + (nntp-decode-text))) (defun nntp-close-group (group &optional server) (setq nntp-current-group nil) @@ -615,7 +622,7 @@ post to this group instead. If RESPECT-POSTER, heed the special () (erase-buffer) (if post - (news-setup nil subject nil group nil) + (news-setup nil subject nil (or follow-to group) nil) (save-excursion (set-buffer article-buffer) (goto-char (point-min)) @@ -1190,15 +1197,16 @@ defining this function as macro." (setq list (cdr list))) (car list)) -(defun nntp-possibly-change-server (newsgroup server) - ;; We see whether it is necessary to change the newsgroup. - (and newsgroup - (progn - (not (equal newsgroup nntp-current-group)) - (nntp-request-group newsgroup server))) - (and server - (or (nntp-server-opened server) - (nntp-open-server server)))) +(defun nntp-possibly-change-server (newsgroup server &optional connectionless) + "Check whether the virtual server needs changing." + (if (and server + (not (nntp-server-opened server))) + ;; This virtual server isn't open, so we (re)open it here. + (nntp-open-server server nil t)) + (if (and newsgroup + (not (equal newsgroup nntp-current-group))) + ;; Set the proper current group. + (nntp-request-group newsgroup server))) (defun nntp-try-list-active (group) (nntp-list-active-group group) -- 2.34.1