Misc changes in gnus-group.el and gnus-topic.el

* gnus-group.el (gnus-tmp-*): Declare.
(gnus-update-group-mark-positions): Remove unused `topic' var.
(gnus-group-insert-group-line): Remove unused var `header'.
(gnus-group--setup-tool-bar-update): New function.
(gnus-group-insert-group-line): Use it.
(gnus-group-update-eval-form): Declare local
dynamically-bound variables.
(gnus-group-unsubscribe-group): Use \` and \' to match string bounds.

* gnus-topic.el (gnus-topic-jump-to-topic)
(gnus-group-prepare-topics, gnus-topic-update-topic)
(gnus-topic-change-level, gnus-topic-catchup-articles)
(gnus-topic-remove-group, gnus-topic-delete, gnus-topic-indent):
Use inhibit-read-only.
(gnus-topic-prepare-topic): Use gnus-group--setup-tool-bar-update.
(gnus-topic-mode): Use define-minor-mode and derived-mode-p.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 8fb3ba7..b175f3d 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,22 @@
+2015-04-13  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+       * gnus-group.el (gnus-tmp-*): Declare.
+       (gnus-update-group-mark-positions): Remove unused `topic' var.
+       (gnus-group-insert-group-line): Remove unused var `header'.
+       (gnus-group--setup-tool-bar-update): New function.
+       (gnus-group-insert-group-line): Use it.
+       (gnus-group-update-eval-form): Declare local
+       dynamically-bound variables.
+       (gnus-group-unsubscribe-group): Use \` and \' to match string bounds.
+
+       * gnus-topic.el (gnus-topic-jump-to-topic)
+       (gnus-group-prepare-topics, gnus-topic-update-topic)
+       (gnus-topic-change-level, gnus-topic-catchup-articles)
+       (gnus-topic-remove-group, gnus-topic-delete, gnus-topic-indent):
+       Use inhibit-read-only.
+       (gnus-topic-prepare-topic): Use gnus-group--setup-tool-bar-update.
+       (gnus-topic-mode): Use define-minor-mode and derived-mode-p.
+

 2015-04-12  João Távora  <joaotavora@gmail.com>
 
        * message.el (message-mode):
 2015-04-12  João Távora  <joaotavora@gmail.com>
 
        * message.el (message-mode):

diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el
index e22138b..8e8d175 100644 (file)
--- a/lisp/gnus-group.el
+++ b/lisp/gnus-group.el
@@ -478,6 +478,26 @@ simple manner.")
 
 (defvar gnus-group-edit-buffer nil)
 
 
 (defvar gnus-group-edit-buffer nil)
 

+(defvar gnus-tmp-news-method)
+(defvar gnus-tmp-colon)
+(defvar gnus-tmp-news-server)
+(defvar gnus-tmp-decoded-group)
+(defvar gnus-tmp-header)
+(defvar gnus-tmp-process-marked)
+(defvar gnus-tmp-summary-live)
+(defvar gnus-tmp-news-method-string)
+(defvar gnus-tmp-group-icon)
+(defvar gnus-tmp-moderated-string)
+(defvar gnus-tmp-newsgroup-description)
+(defvar gnus-tmp-comment)
+(defvar gnus-tmp-qualified-group)
+(defvar gnus-tmp-subscribed)
+(defvar gnus-tmp-number-of-read)
+(defvar gnus-inhibit-demon)
+(defvar gnus-pick-mode)
+(defvar gnus-tmp-marked-mark)
+(defvar gnus-tmp-number-of-unread)
+

 (defvar gnus-group-line-format-alist
   `((?M gnus-tmp-marked-mark ?c)
     (?S gnus-tmp-subscribed ?c)
 (defvar gnus-group-line-format-alist
   `((?M gnus-tmp-marked-mark ?c)
     (?S gnus-tmp-subscribed ?c)


@@ -1140,8 +1160,7 @@ The following commands are available:
     (let ((gnus-process-mark ?\200)
          (gnus-group-update-hook nil)
          (gnus-group-marked '("dummy.group"))
     (let ((gnus-process-mark ?\200)
          (gnus-group-update-hook nil)
          (gnus-group-marked '("dummy.group"))

-         (gnus-active-hashtb (make-vector 10 0))
-         (topic ""))
+         (gnus-active-hashtb (make-vector 10 0)))

       (gnus-set-active "dummy.group" '(0 . 0))
       (gnus-set-work-buffer)
       (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
       (gnus-set-active "dummy.group" '(0 . 0))
       (gnus-set-work-buffer)
       (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)


@@ -1574,7 +1593,7 @@ if it is a string, only list groups matching REGEXP."
              gnus-process-mark ? ))
         (buffer-read-only nil)
         beg end
              gnus-process-mark ? ))
         (buffer-read-only nil)
         beg end

-        header gnus-tmp-header)        ; passed as parameter to user-funcs.
+         gnus-tmp-header)      ; passed as parameter to user-funcs.

     (beginning-of-line)
     (setq beg (point))
     (gnus-add-text-properties
     (beginning-of-line)
     (setq beg (point))
     (gnus-add-text-properties


@@ -1592,20 +1611,31 @@ if it is a string, only list groups matching REGEXP."
                  gnus-indentation ,gnus-group-indentation
                  gnus-level ,gnus-tmp-level))
     (setq end (point))
                  gnus-indentation ,gnus-group-indentation
                  gnus-level ,gnus-tmp-level))
     (setq end (point))

-    (when gnus-group-update-tool-bar
-      (gnus-put-text-property beg end 'point-entered
-                             'gnus-tool-bar-update)
-      (gnus-put-text-property beg end 'point-left
-                             'gnus-tool-bar-update))
+    (gnus-group--setup-tool-bar-update beg end)

     (forward-line -1)
     (when (inline (gnus-visual-p 'group-highlight 'highlight))
       (gnus-group-highlight-line gnus-tmp-group beg end))
     (gnus-run-hooks 'gnus-group-update-hook)
     (forward-line)))
 
     (forward-line -1)
     (when (inline (gnus-visual-p 'group-highlight 'highlight))
       (gnus-group-highlight-line gnus-tmp-group beg end))
     (gnus-run-hooks 'gnus-group-update-hook)
     (forward-line)))
 

+(defun gnus-group--setup-tool-bar-update (beg end)
+  (when gnus-group-update-tool-bar
+    (if (fboundp 'cursor-sensor-mode)
+        (progn
+          (unless (bound-and-true-p cursor-sensor-mode)
+            (cursor-sensor-mode 1))
+          (gnus-put-text-property beg end 'cursor-sensor-functions
+                                  #'gnus-tool-bar-update))
+      (gnus-put-text-property beg end 'point-entered
+                              #'gnus-tool-bar-update)
+      (gnus-put-text-property beg end 'point-left
+                              #'gnus-tool-bar-update))))
+

 (defun gnus-group-update-eval-form (group list)
   "Eval `car' of each element of LIST, and return the first that return t.
 Some value are bound so the form can use them."
 (defun gnus-group-update-eval-form (group list)
   "Eval `car' of each element of LIST, and return the first that return t.
 Some value are bound so the form can use them."

+  (defvar group-age) (defvar ticked) (defvar score) (defvar level)
+  (defvar mailp) (defvar total) (defvar unread)

   (when list
     (let* ((entry (gnus-group-entry group))
            (unread (if (numberp (car entry)) (car entry) 0))
   (when list
     (let* ((entry (gnus-group-entry group))
            (unread (if (numberp (car entry)) (car entry) 0))


@@ -3107,8 +3137,8 @@ If SOLID (the prefix), create a solid group."
 
 (defvar nnrss-group-alist)
 (eval-when-compile
 
 (defvar nnrss-group-alist)
 (eval-when-compile

-  (defun nnrss-discover-feed (arg))
-  (defun nnrss-save-server-data (arg)))
+  (defun nnrss-discover-feed (_arg))
+  (defun nnrss-save-server-data (_arg)))

 (defun gnus-group-make-rss-group (&optional url)
   "Given a URL, discover if there is an RSS feed.
 If there is, use Gnus to create an nnrss group"
 (defun gnus-group-make-rss-group (&optional url)
   "Given a URL, discover if there is an RSS feed.
 If there is, use Gnus to create an nnrss group"


@@ -3757,7 +3787,7 @@ group line."
                      nil nil (gnus-read-active-file-p))))
   (let ((newsrc (gnus-group-entry group)))
     (cond
                      nil nil (gnus-read-active-file-p))))
   (let ((newsrc (gnus-group-entry group)))
     (cond

-     ((string-match "^[ \t]*$" group)
+     ((string-match "\\`[ \t]*\\'" group)

       (error "Empty group name"))
      (newsrc
       ;; Toggle subscription flag.
       (error "Empty group name"))
      (newsrc
       ;; Toggle subscription flag.

diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el
index f536a27..47cdcbc 100644 (file)
--- a/lisp/gnus-topic.el
+++ b/lisp/gnus-topic.el
@@ -154,7 +154,7 @@ See Info node `(gnus)Formatting Variables'."
   "Go to TOPIC."
   (interactive
    (list (gnus-completing-read "Go to topic" (gnus-topic-list) t)))
   "Go to TOPIC."
   (interactive
    (list (gnus-completing-read "Go to topic" (gnus-topic-list) t)))

-  (let ((buffer-read-only nil))
+  (let ((inhibit-read-only t))

     (dolist (topic (gnus-current-topics topic))
       (unless (gnus-topic-goto-topic topic)
        (gnus-topic-goto-missing-topic topic)
     (dolist (topic (gnus-current-topics topic))
       (unless (gnus-topic-goto-topic topic)
        (gnus-topic-goto-missing-topic topic)


@@ -427,7 +427,7 @@ If PREDICATE is a function, list groups that the function returns non-nil;
 if it is t, list groups that have no unread articles.
 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher."
   (set-buffer gnus-group-buffer)
 if it is t, list groups that have no unread articles.
 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher."
   (set-buffer gnus-group-buffer)

-  (let ((buffer-read-only nil)
+  (let ((inhibit-read-only t)

        (lowest (or lowest 1))
        (not-in-list
         (and gnus-group-listed-groups
        (lowest (or lowest 1))
        (not-in-list
         (and gnus-group-listed-groups


@@ -582,11 +582,7 @@ articles in the topic and its subtopics."
        (not (eq (nth 2 type) 'hidden))
        level all-entries unread))
     (gnus-topic-update-unreads (car type) unread)
        (not (eq (nth 2 type) 'hidden))
        level all-entries unread))
     (gnus-topic-update-unreads (car type) unread)

-    (when gnus-group-update-tool-bar
-      (gnus-put-text-property beg end 'point-entered
-                             'gnus-tool-bar-update)
-      (gnus-put-text-property beg end 'point-left
-                             'gnus-tool-bar-update))
+    (gnus-group--setup-tool-bar-update beg end)

     (goto-char end)
     unread))
 
     (goto-char end)
     unread))
 


@@ -684,7 +680,7 @@ articles in the topic and its subtopics."
             gnus-topic-mode)
     (let ((group (gnus-group-group-name))
          (m (point-marker))
             gnus-topic-mode)
     (let ((group (gnus-group-group-name))
          (m (point-marker))

-         (buffer-read-only nil))
+         (inhibit-read-only t))

       (when (and group
                 (gnus-get-info group)
                 (gnus-topic-goto-topic (gnus-current-topic)))
       (when (and group
                 (gnus-get-info group)
                 (gnus-topic-goto-topic (gnus-current-topic)))


@@ -902,7 +898,7 @@ articles in the topic and its subtopics."
 (defun gnus-topic-change-level (group level oldlevel &optional previous)
   "Run when changing levels to enter/remove groups from topics."
   (with-current-buffer gnus-group-buffer
 (defun gnus-topic-change-level (group level oldlevel &optional previous)
   "Run when changing levels to enter/remove groups from topics."
   (with-current-buffer gnus-group-buffer

-    (let ((buffer-read-only nil))
+    (let ((inhibit-read-only t))

       (unless gnus-topic-inhibit-change-level
        (gnus-group-goto-group (or (car (nth 2 previous)) group))
        (when (and gnus-topic-mode
       (unless gnus-topic-inhibit-change-level
        (gnus-group-goto-group (or (car (nth 2 previous)) group))
        (when (and gnus-topic-mode


@@ -1131,22 +1127,17 @@ articles in the topic and its subtopics."
        ["Edit parameters" gnus-topic-edit-parameters t])
        ["List active" gnus-topic-list-active t]))))
 
        ["Edit parameters" gnus-topic-edit-parameters t])
        ["List active" gnus-topic-list-active t]))))
 

-(defun gnus-topic-mode (&optional arg redisplay)
+(define-minor-mode gnus-topic-mode

   "Minor mode for topicsifying Gnus group buffers."
   "Minor mode for topicsifying Gnus group buffers."

-  ;; FIXME: Use define-minor-mode.
-  (interactive (list current-prefix-arg t))
-  (when (eq major-mode 'gnus-group-mode)
-    (make-local-variable 'gnus-topic-mode)
-    (setq gnus-topic-mode
-         (if (null arg) (not gnus-topic-mode)
-           (> (prefix-numeric-value arg) 0)))
+  :lighter " Topic" :keymap gnus-topic-mode-map
+  (if (not (derived-mode-p 'gnus-group-mode))
+      (setq gnus-topic-mode nil)

     ;; Infest Gnus with topics.
     (if (not gnus-topic-mode)
        (setq gnus-goto-missing-group-function nil)
       (when (gnus-visual-p 'topic-menu 'menu)
        (gnus-topic-make-menu-bar))
       (gnus-set-format 'topic t)
     ;; Infest Gnus with topics.
     (if (not gnus-topic-mode)
        (setq gnus-goto-missing-group-function nil)
       (when (gnus-visual-p 'topic-menu 'menu)
        (gnus-topic-make-menu-bar))
       (gnus-set-format 'topic t)

-      (add-minor-mode 'gnus-topic-mode " Topic" gnus-topic-mode-map)

       (add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic)
       (set (make-local-variable 'gnus-group-prepare-function)
           'gnus-group-prepare-topics)
       (add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic)
       (set (make-local-variable 'gnus-group-prepare-function)
           'gnus-group-prepare-topics)


@@ -1168,8 +1159,7 @@ articles in the topic and its subtopics."
       (setq gnus-topology-checked-p nil)
       ;; We check the topology.
       (when gnus-newsrc-alist
       (setq gnus-topology-checked-p nil)
       ;; We check the topology.
       (when gnus-newsrc-alist

-       (gnus-topic-check-topology))
-      (gnus-run-hooks 'gnus-topic-mode-hook))
+       (gnus-topic-check-topology)))

     ;; Remove topic infestation.
     (unless gnus-topic-mode
       (remove-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic)
     ;; Remove topic infestation.
     (unless gnus-topic-mode
       (remove-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic)


@@ -1177,7 +1167,7 @@ articles in the topic and its subtopics."
       (remove-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist)
       (setq gnus-group-prepare-function 'gnus-group-prepare-flat)
       (setq gnus-group-sort-alist-function 'gnus-group-sort-flat))
       (remove-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist)
       (setq gnus-group-prepare-function 'gnus-group-prepare-flat)
       (setq gnus-group-sort-alist-function 'gnus-group-sort-flat))

-    (when redisplay
+    (when (called-interactively-p 'any)

       (gnus-group-list-groups))))
 
 (defun gnus-topic-select-group (&optional all)
       (gnus-group-list-groups))))
 
 (defun gnus-topic-select-group (&optional all)


@@ -1229,10 +1219,10 @@ Also see `gnus-group-catchup'."
       (call-interactively 'gnus-group-catchup-current)
     (save-excursion
       (let* ((groups
       (call-interactively 'gnus-group-catchup-current)
     (save-excursion
       (let* ((groups

-            (mapcar (lambda (entry) (car (nth 2 entry)))
-                    (gnus-topic-find-groups topic gnus-level-killed t
-                                            nil t)))
-            (buffer-read-only nil)
+              (mapcar (lambda (entry) (car (nth 2 entry)))
+                      (gnus-topic-find-groups topic gnus-level-killed t
+                                              nil t)))
+            (inhibit-read-only t)

             (gnus-group-marked groups))
        (gnus-group-catchup-current)
        (mapcar 'gnus-topic-update-topics-containing-group groups)))))
             (gnus-group-marked groups))
        (gnus-group-catchup-current)
        (mapcar 'gnus-topic-update-topics-containing-group groups)))))


@@ -1336,7 +1326,7 @@ If COPYP, copy the groups instead."
      (lambda (group)
        (gnus-group-remove-mark group use-marked)
        (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist))
      (lambda (group)
        (gnus-group-remove-mark group use-marked)
        (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist))

-            (buffer-read-only nil))
+            (inhibit-read-only t))

         (when (and topicl group)
           (gnus-delete-line)
           (gnus-delete-first group topicl))
         (when (and topicl group)
           (gnus-delete-line)
           (gnus-delete-first group topicl))


@@ -1515,7 +1505,7 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics."
   (unless topic
     (error "No topic to be deleted"))
   (let ((entry (assoc topic gnus-topic-alist))
   (unless topic
     (error "No topic to be deleted"))
   (let ((entry (assoc topic gnus-topic-alist))

-       (buffer-read-only nil))
+       (inhibit-read-only t))

     (when (cdr entry)
       (error "Topic not empty"))
     ;; Delete if visible.
     (when (cdr entry)
       (error "Topic not empty"))
     ;; Delete if visible.


@@ -1560,7 +1550,7 @@ If UNINDENT, remove an indentation."
       (gnus-topic-unindent)
     (let* ((topic (gnus-current-topic))
           (parent (gnus-topic-previous-topic topic))
       (gnus-topic-unindent)
     (let* ((topic (gnus-current-topic))
           (parent (gnus-topic-previous-topic topic))

-          (buffer-read-only nil))
+          (inhibit-read-only t))

       (unless parent
        (error "Nothing to indent %s into" topic))
       (when topic
       (unless parent
        (error "Nothing to indent %s into" topic))
       (when topic