;;; nnmairix.el --- Mairix back end for Gnus, the Emacs newsreader
-;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: David Engster <dengste@eml.cc>
;; Keywords: mail searching
(defun nnmairix-summary-mode-hook ()
"Nnmairix summary mode keymap."
(define-key gnus-summary-mode-map
- (kbd "$ t") 'nnmairix-search-thread-this-article)
+ (kbd "G G t") 'nnmairix-search-thread-this-article)
(define-key gnus-summary-mode-map
- (kbd "$ f") 'nnmairix-search-from-this-article)
+ (kbd "G G f") 'nnmairix-search-from-this-article)
(define-key gnus-summary-mode-map
- (kbd "$ m") 'nnmairix-widget-search-from-this-article)
+ (kbd "G G m") 'nnmairix-widget-search-from-this-article)
(define-key gnus-summary-mode-map
- (kbd "$ g") 'nnmairix-create-search-group-from-message)
+ (kbd "G G g") 'nnmairix-create-search-group-from-message)
(define-key gnus-summary-mode-map
- (kbd "$ o") 'nnmairix-goto-original-article)
+ (kbd "G G o") 'nnmairix-goto-original-article)
(define-key gnus-summary-mode-map
- (kbd "$ u") 'nnmairix-remove-tick-mark-original-article))
+ (kbd "G G u") 'nnmairix-remove-tick-mark-original-article))
(add-hook 'gnus-group-mode-hook 'nnmairix-group-mode-hook)
(add-hook 'gnus-summary-mode-hook 'nnmairix-summary-mode-hook)
;; ;;;###autoload
-;; (defun nnmairix-initalize (&optional force)
+;; (defun nnmairix-initialize (&optional force)
;; (interactive "P")
;; (if (not (or (file-readable-p "~/.mairixrc")
;; force))
"Use only the registry for determining original group(s).
If set to t, nnmairix will only use the registry for determining
the original group(s) of an article (which is also necessary for
-propapagting marks). If set to nil, it will also try to determine
+propagating marks). If set to nil, it will also try to determine
the group from an additional mairix search which might be slow
when propagating lots of marks."
:version "23.1"
mfolder query threads)))
;; Check return value
(cond
- ((zerop rval) ; call was succesful
+ ((zerop rval) ; call was successful
(nnmairix-call-backend
"open-server" nnmairix-backend-server)
;; If we're dealing with nnml, rename files
;; Everything else is an error
(t
(nnheader-report
- 'nnmairix "Error running marix. See buffer %s for details"
+ 'nnmairix "Error running mairix. See buffer %s for details"
nnmairix-mairix-output-buffer)
nil))))))
"retrieve-headers" articles folder nnmairix-backend-server fetch-old))
(nnmairix-call-backend
"retrieve-headers" articles folder nnmairix-backend-server fetch-old)))
- (when (eq rval 'nov)
- (nnmairix-replace-group-and-numbers articles folder group numcorr)
- rval)))
+ (nnmairix-replace-group-and-numbers articles folder group numcorr rval)
+ rval))
(deffoo nnmairix-request-article (article &optional group server to-buffer)
(when server (nnmairix-open-server server))
nil))
;; Silence byte-compiler.
-(defvar gnus-registry-install)
-(autoload 'gnus-registry-fetch-group "gnus-registry")
-(autoload 'gnus-registry-fetch-groups "gnus-registry")
-(autoload 'gnus-registry-add-group "gnus-registry")
+(autoload 'gnus-registry-get-id-key "gnus-registry")
(deffoo nnmairix-request-set-mark (group actions &optional server)
(when server
nnmairix-only-use-registry)
(setq ogroup
(nnmairix-determine-original-group-from-path
- mid nnmairix-current-server))
- ;; if available and allowed, add this entry to the registry
- (when (and (boundp 'gnus-registry-install)
- gnus-registry-install)
- (dolist (cur ogroup)
- (unless (gnus-parameter-registry-ignore cur)
- (gnus-registry-add-group mid cur)))))
+ mid nnmairix-current-server)))
(unless ogroup
(nnheader-message
3 "Unable to set mark: couldn't find original group for %s" mid)
All necessary information will be queried from the user."
(interactive)
(let* ((name (read-string "Name of the mairix server: "))
- (server (completing-read "Back end server (TAB for completion): "
- (nnmairix-get-valid-servers) nil 1))
+ (server (gnus-completing-read "Back end server"
+ (nnmairix-get-valid-servers) t))
(mairix (read-string "Command to call mairix: " "mairix"))
(defaultgroup (read-string "Default search group: "))
(backend (symbol-name (car (gnus-server-to-method server))))
If SKIPDEFAULT is t, the default search group will not be
updated.
If UPDATEDB is t, database for SERVERNAME will be updated first."
- (interactive (list (completing-read "Update groups on server: "
+ (interactive (list (gnus-completing-read "Update groups on server"
(nnmairix-get-nnmairix-servers))))
(save-excursion
(when (string-match ".*:\\(.*\\)" servername)
(while
(equal '("")
(setq nnmairix-last-server
- (list (completing-read "Server: " openedserver nil 1
+ (list (gnus-completing-read "Server" openedserver t
(or nnmairix-last-server
"nnmairix:"))))))
nnmairix-last-server)
(not (member (car server) gnus-ephemeral-servers))
(not (member (gnus-method-to-server (car server)) occ)))
(push
- (list mserver)
+ mserver
openedserver)))
openedserver))
(setq cur lastplusone))
(setq lastplusone (1+ cur)))))
-(defun nnmairix-replace-group-and-numbers (articles backendgroup mairixgroup numc)
+(defun nnmairix-replace-group-and-numbers (articles backendgroup mairixgroup numc type)
"Replace folder names in Xref header and correct article numbers.
Do this for all ARTICLES on BACKENDGROUP. Replace using
-MAIRIXGROUP. NUMC contains values for article number correction."
- (let ((buf (get-buffer-create " *nnmairix buffer*"))
- (corr (not (zerop numc)))
- (name (buffer-name nntp-server-buffer))
- header cur xref)
- (with-current-buffer buf
- (erase-buffer)
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (nnheader-message 7 "nnmairix: Rewriting headers...")
- (mapc
- (lambda (article)
- (when (or (looking-at (number-to-string article))
- (nnheader-find-nov-line article))
- (setq cur (nnheader-parse-nov))
- (when corr
- (setq article (+ (mail-header-number cur) numc))
- (mail-header-set-number cur article))
- (setq xref (mail-header-xref cur))
- (when (and (stringp xref)
- (string-match (format "[ \t]%s:[0-9]+" backendgroup) xref))
- (setq xref (replace-match (format " %s:%d" mairixgroup article) t nil xref))
- (mail-header-set-xref cur xref))
- (set-buffer buf)
- (nnheader-insert-nov cur)
- (set-buffer nntp-server-buffer)
- (when (not (eobp))
- (forward-line 1))))
- articles)
- (nnheader-message 7 "nnmairix: Rewriting headers... done")
- (kill-buffer nntp-server-buffer)
- (set-buffer buf)
- (rename-buffer name)
- (setq nntp-server-buffer buf))))
+MAIRIXGROUP. NUMC contains values for article number correction.
+TYPE is either 'nov or 'headers."
+ (nnheader-message 7 "nnmairix: Rewriting headers...")
+ (cond
+ ((eq type 'nov)
+ (let ((buf (get-buffer-create " *nnmairix buffer*"))
+ (corr (not (zerop numc)))
+ (name (buffer-name nntp-server-buffer))
+ header cur xref)
+ (with-current-buffer buf
+ (erase-buffer)
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (mapc
+ (lambda (article)
+ (when (or (looking-at (number-to-string article))
+ (nnheader-find-nov-line article))
+ (setq cur (nnheader-parse-nov))
+ (when corr
+ (setq article (+ (mail-header-number cur) numc))
+ (mail-header-set-number cur article))
+ (setq xref (mail-header-xref cur))
+ (when (and (stringp xref)
+ (string-match (format "[ \t]%s:[0-9]+" backendgroup) xref))
+ (setq xref (replace-match (format " %s:%d" mairixgroup article) t nil xref))
+ (mail-header-set-xref cur xref))
+ (set-buffer buf)
+ (nnheader-insert-nov cur)
+ (set-buffer nntp-server-buffer)
+ (when (not (eobp))
+ (forward-line 1))))
+ articles)
+ (kill-buffer nntp-server-buffer)
+ (set-buffer buf)
+ (rename-buffer name)
+ (setq nntp-server-buffer buf))))
+ ((and (eq type 'headers)
+ (not (zerop numc)))
+ (with-current-buffer nntp-server-buffer
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "^[23][0-9]+ \\([0-9]+\\)" nil t)
+ (replace-match (number-to-string
+ (+ (string-to-number (match-string 1)) numc))
+ t t nil 1))))))
+ (nnheader-message 7 "nnmairix: Rewriting headers... done"))
(defun nnmairix-backend-to-server (server)
"Return nnmairix server most probably responsible for back end SERVER.
(when (not found)
(setq mairixserver
(gnus-server-to-method
- (completing-read
- (format "Cannot determine which nnmairix server indexes %s. Please specify: "
+ (gnus-completing-read
+ (format "Cannot determine which nnmairix server indexes %s. Please specify"
(gnus-method-to-server server))
- (nnmairix-get-nnmairix-servers) nil nil "nnmairix:")))
+ (nnmairix-get-nnmairix-servers) nil "nnmairix:")))
;; Save result in parameter of default search group so that
;; we don't have to ask again
(setq defaultgroup (gnus-group-prefixed-name
(defun nnmairix-replace-illegal-chars (header)
"Replace illegal characters in HEADER for mairix query."
(when header
- (if (> emacs-major-version 20)
- (while (string-match "[^-.@/,& [:alnum:]]" header)
- (setq header (replace-match "" t t header)))
- (while (string-match "[[]{}:<>]" header)
- (setq header (replace-match "" t t header))))
+ (while (string-match "[^-.@/,& [:alnum:]]" header)
+ (setq header (replace-match "" t t header)))
(while (string-match "[-& ]" header)
(setq header (replace-match "," t t header)))
- header))
+ header))
(defun nnmairix-group-toggle-parameter (group parameter description &optional par)
"Toggle on GROUP a certain PARAMETER.
;; registry was not available or did not find article
;; so we search again with mairix in raw mode to get filename
(setq allgroups
- (nnmairix-determine-original-group-from-path mid server))
- ;; if available and allowed, add this entry to the registry
- (when (and (not no-registry)
- (boundp 'gnus-registry-install)
- gnus-registry-install)
- (dolist (cur allgroups)
- (unless (gnus-parameter-registry-ignore cur)
- (gnus-registry-add-group mid cur)))))
+ (nnmairix-determine-original-group-from-path mid server)))
(if (> (length allgroups) 1)
(setq group
- (completing-read
- "Message exists in more than one group. Choose: "
- allgroups nil t))
+ (gnus-completing-read
+ "Message exists in more than one group. Choose"
+ allgroups t))
(setq group (car allgroups))))
(if group
;; show article in summary buffer
(nnheader-message 3 "Couldn't find original article"))))
(defun nnmairix-determine-original-group-from-registry (mid)
- "Try to determinale original group for message-id MID from the registry."
- (when (and (boundp 'gnus-registry-install)
- gnus-registry-install)
+ "Try to determine original group for message-id MID from the registry."
+ (when (gnus-bound-and-true-p 'gnus-registry-enabled)
(unless (string-match "^<" mid)
(set mid (concat "<" mid)))
(unless (string-match ">$" mid)
(set mid (concat mid ">")))
- (gnus-registry-fetch-groups mid)))
+ (gnus-registry-get-id-key mid 'group)))
(defun nnmairix-determine-original-group-from-path (mid server)
"Determine original group(s) for message-id MID from the file path.
(gnus-group-prefixed-name group (car cur))
allgroups))))
(if (> (length allgroups) 1)
- (setq group (completing-read
- "Group %s exists on more than one IMAP server. Choose: "
- allgroups nil t))
+ (setq group (gnus-completing-read
+ "Group %s exists on more than one IMAP server. Choose"
+ allgroups t))
(setq group (car allgroups))))
group))
projects / gnus / blobdiff