(require 'gnus-undo)
(require 'gmm-utils)
(require 'time-date)
-(require 'gnus-ems)
(eval-when-compile
(require 'mm-url)
:group 'gnus-group-visual
:type 'string)
-;; Extracted from gnus-xmas-redefine in order to preserve user settings
-(when (featurep 'xemacs)
- (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add)
- (add-hook 'gnus-group-mode-hook 'gnus-xmas-setup-group-toolbar))
-
(defcustom gnus-group-menu-hook nil
"Hook run after the creation of the group mode menu."
:group 'gnus-group-various
:type '(repeat (cons (sexp :tag "Method") (symbol :tag "Charset"))))
(defcustom gnus-group-name-charset-group-alist
- (if (or (and (fboundp 'find-coding-system) (find-coding-system 'utf-8))
- (mm-coding-system-p 'utf-8))
+ (if (mm-coding-system-p 'utf-8)
'((".*" . utf-8))
nil)
"Alist of group regexp and the charset for group names.
(?O gnus-tmp-moderated-string ?s)
(?p gnus-tmp-process-marked ?c)
(?s gnus-tmp-news-server ?s)
- (?n ,(if (featurep 'xemacs)
- '(symbol-name gnus-tmp-news-method)
- 'gnus-tmp-news-method)
- ?s)
+ (?n gnus-tmp-news-method ?s)
(?P gnus-group-indentation ?s)
(?E gnus-tmp-group-icon ?s)
(?B gnus-tmp-summary-live ?c)
"\C-c\C-i" gnus-info-find-node
"\M-e" gnus-group-edit-group-method
"^" gnus-group-enter-server-mode
- gnus-mouse-2 gnus-mouse-pick-group
- [follow-link] mouse-face
+ [mouse-2] gnus-mouse-pick-group
+ [follow-link] 'mouse-face
"<" beginning-of-buffer
">" end-of-buffer
"\C-c\C-b" gnus-bug
["Catch up" gnus-group-catchup-current
:included (not (gnus-topic-mode-p))
:active (gnus-group-group-name)
- ,@(if (featurep 'xemacs) nil
- '(:help "Mark unread articles in the current group as read"))]
+ :help "Mark unread articles in the current group as read"]
["Catch up " gnus-topic-catchup-articles
:included (gnus-topic-mode-p)
- ,@(if (featurep 'xemacs) nil
- '(:help "Mark unread articles in the current group or topic as read"))]
+ :help "Mark unread articles in the current group or topic as read"]
["Catch up all articles" gnus-group-catchup-current-all
(gnus-group-group-name)]
["Check for new articles" gnus-group-get-new-news-this-group
:included (not (gnus-topic-mode-p))
:active (gnus-group-group-name)
- ,@(if (featurep 'xemacs) nil
- '(:help "Check for new messages in current group"))]
+ :help "Check for new messages in current group"]
["Check for new articles " gnus-topic-get-new-news-this-topic
:included (gnus-topic-mode-p)
- ,@(if (featurep 'xemacs) nil
- '(:help "Check for new messages in current group or topic"))]
+ :help "Check for new messages in current group or topic"]
["Toggle subscription" gnus-group-unsubscribe-current-group
(gnus-group-group-name)]
["Kill" gnus-group-kill-group :active (gnus-group-group-name)
- ,@(if (featurep 'xemacs) nil
- '(:help "Kill (remove) current group"))]
+ :help "Kill (remove) current group"]
["Yank" gnus-group-yank-group gnus-list-of-killed-groups]
["Describe" gnus-group-describe-group :active (gnus-group-group-name)
- ,@(if (featurep 'xemacs) nil
- '(:help "Display description of the current group"))]
+ :help "Display description of the current group"]
;; Actually one should check, if any of the marked groups gives t for
;; (gnus-check-backend-function 'request-expire-articles ...)
["Expire articles" gnus-group-expire-articles
["Send a message (mail or news)" gnus-group-post-news t]
["Create a local message" gnus-group-news t]
["Check for new news" gnus-group-get-new-news
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Get newly arrived articles"))
- ]
+ :help "Get newly arrived articles"]
["Send queued messages" gnus-delay-send-queue
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Send all messages that are scheduled to be sent now"))
- ]
+ :help "Send all messages that are scheduled to be sent now"]
["Activate all groups" gnus-activate-all-groups t]
["Restart Gnus" gnus-group-restart t]
["Read init file" gnus-group-read-init-file t]
["Flush score cache" gnus-score-flush-cache t]
["Toggle topics" gnus-topic-mode t]
["Send a bug report" gnus-bug t]
- ["Exit from Gnus" gnus-group-exit
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Quit reading news"))]
+ ["Exit from Gnus" gnus-group-exit :help "Quit reading news"]
["Exit without saving" gnus-group-quit t]))
(gnus-run-hooks 'gnus-group-menu-hook)))
(defun gnus-group-make-tool-bar (&optional force)
"Make a group mode tool bar from `gnus-group-tool-bar'.
When FORCE, rebuild the tool bar."
- (when (and (not (featurep 'xemacs))
- (boundp 'tool-bar-mode)
+ (when (and (boundp 'tool-bar-mode)
tool-bar-mode
(display-graphic-p)
(or (not gnus-group-tool-bar-map) force))
(let* ((load-path
- (gmm-image-load-path-for-library "gnus"
- "gnus/toggle-subscription.xpm"
- nil t))
- (image-load-path (cons (car load-path)
- (when (boundp 'image-load-path)
- image-load-path)))
+ (image-load-path-for-library
+ "gnus" "gnus/toggle-subscription.xpm" nil t))
+ (image-load-path (cons (car load-path) image-load-path))
(map (gmm-tool-bar-from-list gnus-group-tool-bar
gnus-group-tool-bar-zap-list
'gnus-group-mode-map)))
(goto-char (point-min))
(setq gnus-group-mark-positions
(list (cons 'process (and (search-forward
- (mm-string-to-multibyte "\200") nil t)
+ (string-to-multibyte "\200") nil t)
(- (point) (point-min) 1))))))))
(defun gnus-mouse-pick-group (e)
(defun gnus-group-name-decode (string charset)
;; Fixme: Don't decode in unibyte mode.
- (if (and string charset (featurep 'mule))
- (mm-decode-coding-string string charset)
+ (if (and string charset)
+ (decode-coding-string string charset)
string))
(defun gnus-group-decoded-name (string)
(when (or gnus-group-listed-groups
(and (>= level gnus-level-killed) (<= lowest gnus-level-killed)))
(gnus-group-prepare-flat-list-dead
- (gnus-union
+ (cl-union
not-in-list
(setq gnus-killed-list (sort gnus-killed-list 'string<))
:test 'equal)
(or (not regexp)
(and (stringp regexp) (string-match regexp group))
(and (functionp regexp) (funcall regexp group))))
- (gnus-add-text-properties
+ (add-text-properties
(point) (prog1 (1+ (point))
(insert " " mark " *: "
(gnus-group-decoded-name group)
;; Date: Mon, 23 Jan 2006 19:59:13 +0100
;; Message-ID: <v9acdmrcse.fsf@marauder.physik.uni-ulm.de>
-(defcustom gnus-group-update-tool-bar
- (and (not (featurep 'xemacs))
- (boundp 'tool-bar-mode)
- tool-bar-mode
- ;; Using `redraw-frame' (see `gnus-tool-bar-update') in Emacs might
- ;; be confusing, so maybe we shouldn't call it by default.
- (fboundp 'force-window-update))
+;; Using `redraw-frame' (see `gnus-tool-bar-update') in Emacs might
+;; be confusing, so maybe we shouldn't call it by default.
+(defcustom gnus-group-update-tool-bar (and (boundp 'tool-bar-mode)
+ tool-bar-mode)
"Force updating the group buffer tool bar."
:group 'gnus-group
:version "22.1"
gnus-tmp-header) ; passed as parameter to user-funcs.
(beginning-of-line)
(setq beg (point))
- (gnus-add-text-properties
+ (add-text-properties
(point)
(prog1 (1+ (point))
;; Insert the text.
(progn
(unless (bound-and-true-p cursor-sensor-mode)
(cursor-sensor-mode 1))
- (gnus-put-text-property beg end 'cursor-sensor-functions
+ (put-text-property beg end 'cursor-sensor-functions
'(gnus-tool-bar-update)))
- (gnus-put-text-property beg end 'point-entered
+ (put-text-property beg end 'point-entered
#'gnus-tool-bar-update)
- (gnus-put-text-property beg end 'point-left
+ (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."
- (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))
(active (gnus-active group))
- (total (if active (1+ (- (cdr active) (car active))) 0))
(info (nth 2 entry))
- (method (inline (gnus-server-get-method group (gnus-info-method info))))
+ (method (inline (gnus-server-get-method
+ group (gnus-info-method info))))
(marked (gnus-info-marks info))
- (mailp (apply 'append
- (mapcar
- (lambda (x)
- (memq x (assoc (symbol-name
- (car (or method gnus-select-method)))
- gnus-valid-select-methods)))
- '(mail post-mail))))
- (level (or (gnus-info-level info) gnus-level-killed))
- (score (or (gnus-info-score info) 0))
- (ticked (gnus-range-length (cdr (assq 'tick marked))))
- (group-age (gnus-group-timestamp-delta group)))
- ;; FIXME: http://thread.gmane.org/gmane.emacs.gnus.general/65451/focus=65465
- ;; ======================================================================
- ;; From: Richard Stallman
- ;; Subject: Re: Rewriting gnus-group-highlight-line (was: [...])
- ;; Cc: ding@gnus.org
- ;; Date: Sat, 27 Oct 2007 19:41:20 -0400
- ;; Message-ID: <E1IlvHM-0006TS-7t@fencepost.gnu.org>
- ;;
- ;; [...]
- ;; The kludge is that the alist elements contain expressions that refer
- ;; to local variables with short names. Perhaps write your own tiny
- ;; evaluator that handles just `and', `or', and numeric comparisons
- ;; and just a few specific variables.
- ;; ======================================================================
- ;;
- ;; Similar for other evaluated variables. Grep for risky-local-variable
- ;; to find them! -- rsteib
- ;;
- ;; Eval the cars of the lists until we find a match.
+ (env
+ (list
+ (cons 'unread (if (numberp (car entry)) (car entry) 0))
+ (cons 'total (if active (1+ (- (cdr active) (car active))) 0))
+ (cons 'mailp (apply
+ 'append
+ (mapcar
+ (lambda (x)
+ (memq x (assoc
+ (symbol-name
+ (car (or method gnus-select-method)))
+ gnus-valid-select-methods)))
+ '(mail post-mail))))
+ (cons 'level (or (gnus-info-level info) gnus-level-killed))
+ (cons 'score (or (gnus-info-score info) 0))
+ (cons 'ticked (gnus-range-length (cdr (assq 'tick marked))))
+ (cons 'group-age (gnus-group-timestamp-delta group)))))
(while (and list
- (not (eval (caar list))))
+ (not (eval (caar list) env)))
(setq list (cdr list)))
list)))
(let ((face (cdar (gnus-group-update-eval-form
group
gnus-group-highlight))))
- (unless (eq face (gnus-get-text-property-excluding-characters-with-faces beg 'face))
+ (unless (eq face (gnus-get-text-property-excluding-characters-with-faces
+ beg 'face))
(let ((inhibit-read-only t))
(gnus-put-text-property-excluding-characters-with-faces
beg end 'face
- (if (boundp face) (symbol-value face) face)))
- (gnus-extent-start-open beg))))
+ (if (boundp face) (symbol-value face) face))))))
(defun gnus-group-get-icon (group)
"Return an icon for GROUP according to `gnus-group-icon-list'."
(mode-string (eval gformat)))
;; Say whether the dribble buffer has been modified.
(setq mode-line-modified
- (if modified (car gnus-mode-line-modified)
- (cdr gnus-mode-line-modified)))
+ (if modified "**" "--"))
;; If the line is too long, we chop it off.
(when (> (length mode-string) max-len)
(setq mode-string (substring mode-string 0 (- max-len 4))))
(member group (mapcar 'symbol-name collection))
(symbol-value (intern-soft group collection)))
(setq group
- (mm-encode-coding-string
+ (encode-coding-string
group (gnus-group-name-charset nil group))))
- (gnus-replace-in-string group "\n" "")))
+ (replace-regexp-in-string "\n" "" group)))
;;;###autoload
(defun gnus-fetch-group (group &optional articles)
(unless range (setq range 500))
(when (< range 1)
(error "Invalid range: %s" range))
- (let ((tmpfile (mm-make-temp-file
+ (let ((tmpfile (make-temp-file
(format "%s.start-%s.range-%s." group start range)))
(gnus-thread-sort-functions '(gnus-thread-sort-by-number)))
(with-temp-file tmpfile
(setq ids (string-to-number ids)))
(unless (listp ids)
(setq ids (list ids)))
- (let ((tmpfile (mm-make-temp-file "gnus-temp-group-")))
+ (let ((tmpfile (make-temp-file "gnus-temp-group-")))
(let ((coding-system-for-write 'binary)
(coding-system-for-read 'binary))
(with-temp-file tmpfile
(mm-disable-multibyte)
(dolist (id ids)
- (url-insert-file-contents (format mbox-url id)))
+ (let ((file (format "~/.emacs.d/debbugs-cache/%s" id)))
+ (if (and (not gnus-plugged)
+ (file-exists-p file))
+ (insert-file-contents file)
+ (url-insert-file-contents (format mbox-url id)))))
(goto-char (point-min))
;; Add the debbugs address so that we can respond to reports easily.
(while (re-search-forward "^To: " nil t)
(end-of-line)
(insert (format ", %s@%s" (car ids)
- (gnus-replace-in-string
- (gnus-replace-in-string mbox-url "^http://" "")
- "/.*$" ""))))))
+ (replace-regexp-in-string
+ "/.*$" ""
+ (replace-regexp-in-string "^http://" "" mbox-url)))))))
(gnus-group-read-ephemeral-group
(format "nndoc+ephemeral:bug#%s"
(mapconcat 'number-to-string ids ","))
(when (stringp method)
(setq method (or (gnus-server-to-method method) method)))
(unless encoded
- (setq name (mm-encode-coding-string
+ (setq name (encode-coding-string
name
(gnus-group-name-charset method name))))
(let* ((meth (gnus-method-simplify
"Rename group to: "
(gnus-group-real-name (gnus-group-decoded-name group)))
method (gnus-info-method (gnus-get-info group)))
- (list group (mm-encode-coding-string
+ (list group (encode-coding-string
new-name
(gnus-group-name-charset
method
(gnus-info-params info))
(t info))
;; The proper documentation.
- (gnus-format-message
+ (format-message
"Editing the %s for `%s'."
(cond
((eq part 'method) "select method")
(list 'nndoc-address file)
(list 'nndoc-article-type (or type 'guess))))
(coding (gnus-group-name-charset method name)))
- (setcar (cdr method) (mm-encode-coding-string file coding))
+ (setcar (cdr method) (encode-coding-string file coding))
(gnus-group-make-group
- (mm-encode-coding-string (gnus-group-real-name name) coding)
+ (encode-coding-string (gnus-group-real-name name) coding)
method nil nil t)))
(defvar nnweb-type-definition)
(coding (gnus-group-name-charset '(nnrss "") title)))
(when coding
;; Unify non-ASCII text.
- (setq title (mm-decode-coding-string
- (mm-encode-coding-string title coding)
+ (setq title (decode-coding-string
+ (encode-coding-string title coding)
coding)))
(gnus-group-make-group title '(nnrss ""))
(push (list title href desc) nnrss-group-alist)
(error "%s is not an nnimap group" group))
(unless (setq acl (nnimap-acl-get mailbox (cadr method)))
(error "Server does not support ACL's"))
- (gnus-edit-form acl (gnus-format-message "\
+ (gnus-edit-form acl (format-message "\
Editing the access control list for `%s'.
An access control list is a list of (identifier . rights) elements.
(erase-buffer)
(while groups
(setq group (pop groups))
- (gnus-add-text-properties
+ (add-text-properties
(point) (prog1 (1+ (point))
(insert " *: "
(gnus-group-decoded-name group)
(gnus-read-all-descriptions-files)))
(error "Couldn't request descriptions file"))
(let ((buffer-read-only nil)
- b)
- (erase-buffer)
+ b groups)
(mapatoms
(lambda (group)
- (setq b (point))
- (let ((charset (gnus-group-name-charset nil (symbol-name group))))
- (insert (format " *: %-20s %s\n"
- (gnus-group-name-decode
- (symbol-name group) charset)
- (gnus-group-name-decode
- (symbol-value group) charset))))
- (gnus-add-text-properties
- b (1+ b) (list 'gnus-group group
- 'gnus-unread t 'gnus-marked nil
- 'gnus-level (1+ gnus-level-subscribed))))
+ (push (symbol-name group) groups))
gnus-description-hashtb)
+ (setq groups (sort groups 'string<))
+ (erase-buffer)
+ (dolist (group groups)
+ (setq b (point))
+ (let ((charset (gnus-group-name-charset nil group)))
+ (insert (format " *: %-20s %s\n"
+ (gnus-group-name-decode group charset)
+ (gnus-group-name-decode group charset))))
+ (add-text-properties
+ b (1+ b) (list 'gnus-group (intern group gnus-description-hashtb)
+ 'gnus-unread t 'gnus-marked nil
+ 'gnus-level (1+ gnus-level-subscribed))))
(goto-char (point-min))
(gnus-group-position-point)))
(if force
(if (null articles)
(setcar (nthcdr 3 info)
- (gnus-delete-alist type (car marked)))
+ (assq-delete-all type (car marked)))
(setcdr m (gnus-compress-sequence articles t)))
(setcdr m (gnus-compress-sequence
(sort (nconc (gnus-uncompress-range (cdr m))
(gnus-group-list-mode gnus-group-list-mode) ;; Save it.
func)
(push last-command-event unread-command-events)
- (if (featurep 'xemacs)
- (push (make-event 'key-press '(key ?A)) unread-command-events)
- (push ?A unread-command-events))
+ (push ?A unread-command-events)
(let (gnus-pick-mode keys)
- (setq keys (if (featurep 'xemacs)
- (events-to-keys (read-key-sequence nil))
- (read-key-sequence nil)))
- (setq func (lookup-key (current-local-map) keys)))
+ (setq keys (read-key-sequence nil)
+ func (lookup-key (current-local-map) keys)))
(if (or (not func)
(numberp func))
(ding)