emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] Changes to emacs/lisp/gnus/gnus-start.el,v


From: Miles Bader
Subject: [Emacs-diffs] Changes to emacs/lisp/gnus/gnus-start.el,v
Date: Sun, 28 Oct 2007 09:18:48 +0000

CVSROOT:        /cvsroot/emacs
Module name:    emacs
Changes by:     Miles Bader <miles>     07/10/28 09:18:40

Index: lisp/gnus/gnus-start.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/gnus/gnus-start.el,v
retrieving revision 1.50
retrieving revision 1.51
diff -u -b -r1.50 -r1.51
--- lisp/gnus/gnus-start.el     26 Jul 2007 05:26:59 -0000      1.50
+++ lisp/gnus/gnus-start.el     28 Oct 2007 09:18:27 -0000      1.51
@@ -506,19 +506,23 @@
 
 (defun gnus-subscribe-hierarchical-interactive (groups)
   (let ((groups (sort groups 'string<))
-       prefixes prefix start ans group starts)
+       prefixes prefix start ans group starts real-group)
     (while groups
       (setq prefixes (list "^"))
       (while (and groups prefixes)
-       (while (not (string-match (car prefixes) (car groups)))
+       (while (not (string-match (car prefixes)
+                                 (gnus-group-real-name (car groups))))
          (setq prefixes (cdr prefixes)))
        (setq prefix (car prefixes))
        (setq start (1- (length prefix)))
-       (if (and (string-match "[^\\.]\\." (car groups) start)
+       (if (and (string-match "[^\\.]\\." (gnus-group-real-name (car groups))
+                              start)
                 (cdr groups)
                 (setq prefix
-                      (concat "^" (substring (car groups) 0 (match-end 0))))
-                (string-match prefix (cadr groups)))
+                      (concat "^" (substring
+                                   (gnus-group-real-name (car groups))
+                                   0 (match-end 0))))
+                (string-match prefix (gnus-group-real-name (cadr groups))))
            (progn
              (push prefix prefixes)
              (message "Descend hierarchy %s? ([y]nsq): "
@@ -530,16 +534,18 @@
                         (substring prefix 1 (1- (length prefix)))))
              (cond ((= ans ?n)
                     (while (and groups
-                                (string-match prefix
-                                              (setq group (car groups))))
+                                (setq group (car groups)
+                                      real-group (gnus-group-real-name group))
+                                (string-match prefix real-group))
                       (push group gnus-killed-list)
                       (gnus-sethash group group gnus-killed-hashtb)
                       (setq groups (cdr groups)))
                     (setq starts (cdr starts)))
                    ((= ans ?s)
                     (while (and groups
-                                (string-match prefix
-                                              (setq group (car groups))))
+                                (setq group (car groups)
+                                      real-group (gnus-group-real-name group))
+                                (string-match prefix real-group))
                       (gnus-sethash group group gnus-killed-hashtb)
                       (gnus-subscribe-alphabetically (car groups))
                       (setq groups (cdr groups)))
@@ -632,8 +638,7 @@
     ;; We subscribe the group by changing its level to `subscribed'.
     (gnus-group-change-level
      newsgroup gnus-level-default-subscribed
-     gnus-level-killed (gnus-gethash (or next "dummy.group")
-                                    gnus-newsrc-hashtb))
+     gnus-level-killed (gnus-group-entry (or next "dummy.group")))
     (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)
     (run-hook-with-args 'gnus-subscribe-newsgroup-hooks newsgroup)
     t))
@@ -755,6 +760,13 @@
     (nnheader-init-server-buffer)
     (setq gnus-slave slave)
     (gnus-read-init-file)
+
+    ;; Add "native" to gnus-predefined-server-alist just to have a
+    ;; name for the native select method.
+    (when gnus-select-method
+      (push (cons "native" gnus-select-method)
+           gnus-predefined-server-alist))
+    
     (if gnus-agent
        (gnus-agentize))
 
@@ -787,11 +799,6 @@
          (when (or gnus-slave gnus-use-dribble-file)
            (gnus-dribble-read-file))
 
-         ;; Allow using GroupLens predictions.
-         (when gnus-use-grouplens
-           (bbb-login)
-           (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode))
-
          ;; Do the actual startup.
          (if gnus-agent
              (gnus-request-create-group "queue" '(nndraft "")))
@@ -809,8 +816,7 @@
 (defun gnus-start-draft-setup ()
   "Make sure the draft group exists."
   (gnus-request-create-group "drafts" '(nndraft ""))
-  (unless (gnus-gethash "nndraft:drafts" gnus-newsrc-hashtb)
-    (gnus-message 3 "Subscribing drafts group")
+  (unless (gnus-group-entry "nndraft:drafts")
     (let ((gnus-level-default-subscribed 1))
       (gnus-subscribe-group "nndraft:drafts" nil '(nndraft ""))))
   (unless (equal (gnus-group-get-parameter "nndraft:drafts" 'gnus-dummy t)
@@ -891,7 +897,7 @@
          (when (and (file-exists-p gnus-current-startup-file)
                     (file-exists-p dribble-file)
                     (setq modes (file-modes gnus-current-startup-file)))
-           (set-file-modes dribble-file modes))
+           (gnus-set-file-modes dribble-file modes))
          (goto-char (point-min))
          (when (search-forward "Gnus was exited on purpose" nil t)
            (setq purpose t))
@@ -961,20 +967,18 @@
       (gnus-read-newsrc-file rawfile))
 
     ;; Make sure the archive server is available to all and sundry.
-    (when gnus-message-archive-method
-      (unless (assoc "archive" gnus-server-alist)
        (let ((method (or (and (stringp gnus-message-archive-method)
                               (gnus-server-to-method
                                gnus-message-archive-method))
                          gnus-message-archive-method)))
          ;; Check whether the archive method is writable.
-         (unless (or (stringp method)
+      (unless (or (not method)
+                 (stringp method)
                      (memq 'respool (assoc (format "%s" (car method))
                                            gnus-valid-select-methods)))
            (setq method "archive")) ;; The default.
-         (push (if (stringp method)
-                   `("archive"
-                     nnfolder
+      (when (stringp method)
+       (setq method `(nnfolder
                      ,method
                      (nnfolder-directory
                       ,(nnheader-concat message-directory method))
@@ -982,9 +986,15 @@
                       ,(nnheader-concat message-directory
                                         (concat method "/active")))
                      (nnfolder-get-new-mail nil)
-                     (nnfolder-inhibit-expiry t))
-                 (cons "archive" method))
+                      (nnfolder-inhibit-expiry t))))
+      (if (assoc "archive" gnus-server-alist)
+         (when gnus-update-message-archive-method
+           (if method
+               (setcdr (assoc "archive" gnus-server-alist) method)
+             (setq gnus-server-alist (delq (assoc "archive" gnus-server-alist)
                gnus-server-alist))))
+       (when method
+         (push (cons "archive" method) gnus-server-alist))))
 
     ;; If we don't read the complete active file, we fill in the
     ;; hashtb here.
@@ -1334,16 +1344,16 @@
     (when (and (stringp entry)
               oldlevel
               (< oldlevel gnus-level-zombie))
-      (setq entry (gnus-gethash entry gnus-newsrc-hashtb)))
+      (setq entry (gnus-group-entry entry)))
     (if (and (not oldlevel)
             (consp entry))
        (setq oldlevel (gnus-info-level (nth 2 entry)))
       (setq oldlevel (or oldlevel gnus-level-killed)))
     (when (stringp previous)
-      (setq previous (gnus-gethash previous gnus-newsrc-hashtb)))
+      (setq previous (gnus-group-entry previous)))
 
     (if (and (>= oldlevel gnus-level-zombie)
-            (gnus-gethash group gnus-newsrc-hashtb))
+            (gnus-group-entry group))
        ;; We are trying to subscribe a group that is already
        ;; subscribed.
        ()                              ; Do nothing.
@@ -1367,8 +1377,7 @@
                   entry)
          (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb)
          (when (nth 3 entry)
-           (setcdr (gnus-gethash (car (nth 3 entry))
-                                 gnus-newsrc-hashtb)
+           (setcdr (gnus-group-entry (car (nth 3 entry)))
                    (cdr entry)))
          (setcdr (cdr entry) (cdddr entry)))))
 
@@ -1428,7 +1437,7 @@
            (gnus-sethash group (cons num previous)
                          gnus-newsrc-hashtb))
          (when (cdr entry)
-           (setcdr (gnus-gethash (caadr entry) gnus-newsrc-hashtb) entry))
+           (setcdr (gnus-group-entry (caadr entry)) entry))
          (gnus-dribble-enter
           (format
            "(gnus-group-set-info '%S)" info)))))
@@ -1439,7 +1448,7 @@
 (defun gnus-kill-newsgroup (newsgroup)
   "Obsolete function.  Kills a newsgroup."
   (gnus-group-change-level
-   (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed))
+   (gnus-group-entry newsgroup) gnus-level-killed))
 
 (defun gnus-check-bogus-newsgroups (&optional confirm)
   "Remove bogus newsgroups.
@@ -1467,14 +1476,14 @@
           (lambda (group)
             ;; Remove all bogus subscribed groups by first killing them, and
             ;; then removing them from the list of killed groups.
-            (when (setq entry (gnus-gethash group gnus-newsrc-hashtb))
+            (when (setq entry (gnus-group-entry group))
               (gnus-group-change-level entry gnus-level-killed)
               (setq gnus-killed-list (delete group gnus-killed-list))))
           bogus '("group" "groups" "remove"))
        (while (setq group (pop bogus))
          ;; Remove all bogus subscribed groups by first killing them, and
          ;; then removing them from the list of killed groups.
-         (when (setq entry (gnus-gethash group gnus-newsrc-hashtb))
+         (when (setq entry (gnus-group-entry group))
            (gnus-group-change-level entry gnus-level-killed)
            (setq gnus-killed-list (delete group gnus-killed-list)))))
       ;; Then we remove all bogus groups from the list of killed and
@@ -1543,8 +1552,8 @@
           ;; command may have responded with the `(0 . 0)'.  We
           ;; ignore this if we already have an active entry
           ;; for the group.
-          (if (and (zerop (car active))
-                   (zerop (cdr active))
+          (if (and (zerop (or (car active) 0))
+                   (zerop (or (cdr active) 0))
                    (gnus-active group))
               (gnus-active group)
 
@@ -1652,8 +1661,8 @@
        (setq num (max 0 (- (cdr active) num)))))
       ;; Set the number of unread articles.
       (when (and info
-                (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb))
-       (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num))
+                (gnus-group-entry (gnus-info-group info)))
+       (setcar (gnus-group-entry (gnus-info-group info)) num))
       num)))
 
 ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
@@ -1674,7 +1683,7 @@
         (methods-cache nil)
         (type-cache nil)
         scanned-methods info group active method retrieve-groups cmethod
-        method-type)
+        method-type ignore)
     (gnus-message 6 "Checking new news...")
 
     (while newsrc
@@ -1711,10 +1720,11 @@
                     'foreign)))
        (push (cons method method-type) type-cache))
 
+      (setq ignore nil)
       (cond ((and method (eq method-type 'foreign))
             ;; These groups are foreign.  Check the level.
-            (when (and (<= (gnus-info-level info) foreign-level)
-                       (setq active (gnus-activate-group group 'scan)))
+            (if (<= (gnus-info-level info) foreign-level)
+                (when (setq active (gnus-activate-group group 'scan))
               ;; Let the Gnus agent save the active file.
               (when (and gnus-agent active (gnus-online method))
                 (gnus-agent-save-group-info
@@ -1723,7 +1733,8 @@
                 (inline (gnus-close-group group)))
               (when (fboundp (intern (concat (symbol-name (car method))
                                              "-request-update-info")))
-                (inline (gnus-request-update-info info method)))))
+                    (inline (gnus-request-update-info info method))))
+              (setq ignore t)))
            ;; These groups are native or secondary.
            ((> (gnus-info-level info) level)
             ;; We don't want these groups.
@@ -1762,13 +1773,17 @@
        ((eq active 'ignore)
        ;; Don't do anything.
        )
+       ((and active ignore)
+       ;; The level of the foreign group is higher than the specified
+       ;; value.
+       )
        (active
        (inline (gnus-get-unread-articles-in-group info active t)))
        (t
        ;; The group couldn't be reached, so we nix out the number of
        ;; unread articles and stuff.
        (gnus-set-active group nil)
-       (let ((tmp (gnus-gethash group gnus-newsrc-hashtb)))
+       (let ((tmp (gnus-group-entry group)))
          (when tmp
            (setcar tmp t))))))
 
@@ -1793,7 +1808,7 @@
              ;; The group couldn't be reached, so we nix out the number of
              ;; unread articles and stuff.
              (gnus-set-active group nil)
-             (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))))))
+             (setcar (gnus-group-entry group) t)))))))
 
     (gnus-message 6 "Checking new news...done")))
 
@@ -1802,7 +1817,7 @@
 (defun gnus-make-hashtable-from-newsrc-alist ()
   (let ((alist gnus-newsrc-alist)
        (ohashtb gnus-newsrc-hashtb)
-       prev)
+       prev info method rest methods)
     (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)))
     (setq alist
          (setq prev (setq gnus-newsrc-alist
@@ -1811,14 +1826,26 @@
                               gnus-newsrc-alist
                             (cons (list "dummy.group" 0 nil) alist)))))
     (while alist
+      (setq info (car alist))
+      ;; Make the same select-methods identical Lisp objects.
+      (when (setq method (gnus-info-method info))
+       (if (setq rest (member method methods))
+           (gnus-info-set-method info (car rest))
+         (push method methods)))
       (gnus-sethash
-       (caar alist)
+       (car info)
        ;; Preserve number of unread articles in groups.
-       (cons (and ohashtb (car (gnus-gethash (caar alist) ohashtb)))
+       (cons (and ohashtb (car (gnus-gethash (car info) ohashtb)))
             prev)
        gnus-newsrc-hashtb)
       (setq prev alist
-           alist (cdr alist)))))
+           alist (cdr alist)))
+    ;; Make the same select-methods in `gnus-server-alist' identical
+    ;; as well.
+    (while methods
+      (setq method (pop methods))
+      (when (setq rest (rassoc method gnus-server-alist))
+       (setcdr rest method)))))
 
 (defun gnus-make-hashtable-from-killed ()
   "Create a hash table from the killed and zombie lists."
@@ -1845,9 +1872,9 @@
 
 (defun gnus-make-articles-unread (group articles)
   "Mark ARTICLES in GROUP as unread."
-  (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb)
-                         (gnus-gethash (gnus-group-real-name group)
-                                       gnus-newsrc-hashtb))))
+  (let* ((info (nth 2 (or (gnus-group-entry group)
+                         (gnus-group-entry
+                          (gnus-group-real-name group)))))
         (ranges (gnus-info-read info))
         news article)
     (while articles
@@ -1867,9 +1894,8 @@
 
 (defun gnus-make-ascending-articles-unread (group articles)
   "Mark ascending ARTICLES in GROUP as unread."
-  (let* ((entry (or (gnus-gethash group gnus-newsrc-hashtb)
-                    (gnus-gethash (gnus-group-real-name group)
-                                  gnus-newsrc-hashtb)))
+  (let* ((entry (or (gnus-group-entry group)
+                    (gnus-group-entry (gnus-group-real-name group))))
          (info (nth 2 entry))
         (ranges (gnus-info-read info))
          (r ranges)
@@ -1941,7 +1967,7 @@
     (while lists
       (setq killed (car lists))
       (while killed
-       (gnus-sethash (car killed) nil hashtb)
+       (gnus-sethash (mm-string-as-unibyte (car killed)) nil hashtb)
        (setq killed (cdr killed)))
       (setq lists (cdr lists)))))
 
@@ -2118,7 +2144,7 @@
       (while (not (eobp))
        (condition-case ()
            (progn
-             (narrow-to-region (point) (gnus-point-at-eol))
+             (narrow-to-region (point) (point-at-eol))
              ;; group gets set to a symbol interned in the hash table
              ;; (what a hack!!) - jwz
              (setq group (let ((obarray hashtb)) (read cur)))
@@ -2150,7 +2176,7 @@
           (unless ignore-errors
             (gnus-message 3 "Warning - invalid active: %s"
                           (buffer-substring
-                           (gnus-point-at-bol) (gnus-point-at-eol))))))
+                           (point-at-bol) (point-at-eol))))))
        (widen)
        (forward-line 1)))))
 
@@ -2387,6 +2413,8 @@
            (setq gnus-format-specs gnus-default-format-specs)))
        (when gnus-newsrc-assoc
          (setq gnus-newsrc-alist gnus-newsrc-assoc))))
+    (dolist (elem gnus-newsrc-alist)
+      (setcar elem (mm-string-as-unibyte (car elem))))
     (gnus-make-hashtable-from-newsrc-alist)
     (when (file-newer-than-file-p file ding-file)
       ;; Old format quick file
@@ -2502,10 +2530,10 @@
              ;; don't give a damn, frankly, my dear.
              (concat gnus-newsrc-options
                      (buffer-substring
-                      (gnus-point-at-bol)
+                      (point-at-bol)
                       ;; Options may continue on the next line.
                       (or (and (re-search-forward "^[^ \t]" nil 'move)
-                               (progn (beginning-of-line) (point)))
+                               (point-at-bol))
                           (point)))))
        (forward-line -1))
        (symbol
@@ -2573,8 +2601,8 @@
                ;; The line was buggy.
                (setq group nil)
                (gnus-error 3.1 "Mangled line: %s"
-                           (buffer-substring (gnus-point-at-bol)
-                                             (gnus-point-at-eol))))
+                           (buffer-substring (point-at-bol)
+                                             (point-at-eol))))
              nil))
          ;; Skip past ", ".  Spaces are invalid in these ranges, but
          ;; we allow them, because it's a common mistake to put a
@@ -2683,9 +2711,9 @@
       (while (re-search-forward "[ \t]-n" nil t)
        (setq eol
              (or (save-excursion
-                   (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t)
+                   (and (re-search-forward "[ \t]-n" (point-at-eol) t)
                         (- (point) 2)))
-                 (gnus-point-at-eol)))
+                 (point-at-eol)))
        ;; Search for all "words"...
        (while (re-search-forward "[^ \t,\n]+" eol t)
          (if (eq (char-after (match-beginning 0)) ?!)
@@ -2793,7 +2821,7 @@
 
                       ;; Replace the existing startup file with the temp file.
                       (rename-file working-file startup-file t)
-                      (set-file-modes startup-file setmodes)))
+                      (gnus-set-file-modes startup-file setmodes)))
                 (condition-case nil
                     (delete-file working-file)
                   (file-error nil)))))
@@ -2845,7 +2873,7 @@
       (while variables
        (when (and (boundp (setq variable (pop variables)))
                   (symbol-value variable))
-         (princ "(setq ")
+         (princ "\n(setq ")
           (princ (symbol-name variable))
           (princ " '")
          (prin1 (symbol-value variable))
@@ -2872,6 +2900,10 @@
       (setq default-directory (file-name-directory buffer-file-name))
       (buffer-disable-undo)
       (erase-buffer)
+      ;; Use a unibyte buffer since group names are unibyte strings;
+      ;; in particular, non-ASCII group names are the ones encoded by
+      ;; a certain coding system.
+      (mm-disable-multibyte)
       ;; Write options.
       (when gnus-newsrc-options
        (insert gnus-newsrc-options))
@@ -2914,7 +2946,8 @@
          (delete-file gnus-startup-file)
        (clear-visited-file-modtime))
       (gnus-run-hooks 'gnus-save-standard-newsrc-hook)
-      (save-buffer)
+      (let ((coding-system-for-write 'raw-text))
+       (save-buffer))
       (kill-buffer (current-buffer)))))
 
 
@@ -2926,7 +2959,7 @@
 
 (defun gnus-slave-mode ()
   "Minor mode for slave Gnusae."
-  (gnus-add-minor-mode 'gnus-slave-mode " Slave" (make-sparse-keymap))
+  (add-minor-mode 'gnus-slave-mode " Slave" (make-sparse-keymap))
   (gnus-run-hooks 'gnus-slave-mode-hook))
 
 (defun gnus-slave-save-newsrc ()
@@ -2939,7 +2972,7 @@
       (let ((coding-system-for-write gnus-ding-file-coding-system))
        (gnus-write-buffer slave-name))
       (when modes
-       (set-file-modes slave-name modes)))))
+       (gnus-set-file-modes slave-name modes)))))
 
 (defun gnus-master-read-slave-newsrc ()
   (let ((slave-files
@@ -3117,6 +3150,41 @@
         (symbol-value 'nnimap-mailbox-info)
        (make-vector 1 0)))))
 
+(defun gnus-check-reasonable-setup ()
+  ;; Check whether nnml and nnfolder share a directory.
+  (let ((display-warn
+        (if (fboundp 'display-warning)
+            'display-warning
+          (lambda (type message)
+            (if noninteractive
+                (message "Warning (%s): %s" type message)
+              (let (window)
+                (with-current-buffer (get-buffer-create "*Warnings*")
+                  (goto-char (point-max))
+                  (unless (bolp)
+                    (insert "\n"))
+                  (insert (format "Warning (%s): %s\n" type message))
+                  (setq window (display-buffer (current-buffer)))
+                  (set-window-start
+                   window
+                   (prog2
+                       (forward-line (- 1 (window-height window)))
+                       (point)
+                     (goto-char (point-max))))))))))
+       method active actives match)
+    (dolist (server gnus-server-alist)
+      (setq method (gnus-server-to-method server)
+           active (intern (format "%s-active-file" (car method))))
+      (when (and (member (car method) '(nnml nnfolder))
+                (gnus-server-opened method)
+                (boundp active))
+       (when (setq match (assoc (symbol-value active) actives))
+         (funcall display-warn 'gnus-server
+                  (format "%s and %s share the same active file %s"
+                          (car method)
+                          (cadr match)
+                          (car match))))
+       (push (list (symbol-value active) method) actives)))))
 
 (provide 'gnus-start)
 




reply via email to

[Prev in Thread] Current Thread [Next in Thread]