├── .gitignore ├── LICENSE ├── README.asciidoc └── mbsync.el /.gitignore: -------------------------------------------------------------------------------- 1 | *.elc 2 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE 2 | Version 2, December 2004 3 | 4 | Copyright (C) 2012-2017 Dimitri Fontaine 5 | 6 | Everyone is permitted to copy and distribute verbatim or modified 7 | copies of this license document, and changing it is allowed as long 8 | as the name is changed. 9 | 10 | DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE 11 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 12 | 13 | 0. You just DO WHAT THE FUCK YOU WANT TO. -------------------------------------------------------------------------------- /README.asciidoc: -------------------------------------------------------------------------------- 1 | = mbsync-el 2 | 3 | This Emacs Lisp package allows to easily call the +mbsync+ command line from 4 | the +isync+ tool directly from within Emacs. 5 | 6 | See http://isync.sourceforge.net/mbsync.html 7 | 8 | == gnus integration 9 | 10 | Typical gnus integration is as follows: 11 | 12 | -------------------------------------------------------------------------------- 13 | ;; f runs the command mbsync 14 | (require 'mbsync) 15 | (add-hook 'mbsync-exit-hook 'gnus-group-get-new-news) 16 | (define-key gnus-group-mode-map (kbd "f") 'mbsync) 17 | -------------------------------------------------------------------------------- 18 | -------------------------------------------------------------------------------- /mbsync.el: -------------------------------------------------------------------------------- 1 | ;;; mbsync.el --- run mbsync to fetch mails 2 | 3 | ;; Copyright (C) 2012-2017 Dimitri Fontaine 4 | 5 | ;; Author: Dimitri Fontaine 6 | ;; Version: 0.1.2 7 | ;; URL: https://github.com/dimitri/mbsync-el 8 | 9 | ;; This file is NOT part of GNU Emacs. 10 | 11 | ;; mbsync-el is free software, see the file LICENSE. 12 | 13 | ;;; Commentary: 14 | ;; 15 | ;; Run mbsync to fetch mails 16 | 17 | ;;; News: 18 | 19 | ;;;; Changes since 0.0.1: 20 | ;; 21 | ;; - `mbsync-verbose' now has several levels of verbosity 22 | ;; 23 | ;; - Update status line regex and make it customizable. (#4, #10) 24 | ;; New defcustom mbsync-status-line-re – thanks Matthew Carter and 25 | ;; Ivan Stefanischin! 26 | ;; 27 | ;; - Ensure only one process runs at a time. (#8, #9) 28 | ;; If you wish to run several at a time (e.g. with different 29 | ;; configurations), let-bind `mbsync-buffer-name' around invocations 30 | ;; to keep them unique. Thanks Matthew Carter! 31 | 32 | ;;; Code: 33 | 34 | (require 'cl-lib) 35 | 36 | (defgroup mbsync nil "mbsync customization group" 37 | :group 'convenience) 38 | 39 | (defcustom mbsync-exit-hook nil 40 | "Hook run after `mbsync' is done." 41 | :group 'mbsync 42 | :type 'hook) 43 | 44 | (defcustom mbsync-executable (executable-find "mbsync") 45 | "Where to find the `mbsync' utility." 46 | :group 'mbsync 47 | :type 'string) 48 | 49 | (defcustom mbsync-args '("-a") 50 | "List of options to pass to the `mbsync' command." 51 | :group 'mbsync 52 | :type '(repeat string)) 53 | 54 | (defcustom mbsync-auto-accept-certs nil 55 | "Accept all certificates if true." 56 | :group 'mbsync 57 | :type 'boolean) 58 | 59 | (defcustom mbsync-verbose 'normal 60 | "How many messages to print to minibuffer. See `mbsync-log-levels'." 61 | :group 'mbsync 62 | :type 'boolean) 63 | 64 | (defface mbsync-font-lock-error-face 65 | '((t (:foreground "yellow" :background "red" :bold t))) 66 | "Face description for all errors." 67 | :group 'mbsync) 68 | 69 | (defcustom mbsync-status-line-re (rx "B: " 70 | (group (+ (any alnum ?/)))) 71 | "Regex which matches an output line to show it in the echo-area." 72 | :group 'mbsync 73 | :type 'string) 74 | 75 | (defvar mbsync-last-status nil) 76 | 77 | (defvar mbsync-process-filter-pos nil) 78 | 79 | (defvar mbsync-buffer-name "*mbsync*") 80 | 81 | (defun mbsync-elem-index (elt lst) 82 | "Return index of ELT in LST, or nil if not found." 83 | (let ((i 0)) 84 | (catch 'found 85 | (dolist (e lst) 86 | (if (eq e elt) 87 | (throw 'found i) 88 | (cl-incf i)))))) 89 | 90 | (defvar mbsync-log-levels '(quiet normal verbose debug)) 91 | 92 | (defun mbsync-log-level-int (severity) 93 | "Get the log level of SEVERITY as int." 94 | (or (mbsync-elem-index severity mbsync-log-levels) 95 | 0)) 96 | 97 | (defun mbsync-log (severity &rest args) 98 | "If SEVERITY is less than `mbsync-verbose', show user the message ARGS." 99 | (when (>= (mbsync-log-level-int mbsync-verbose) 100 | (mbsync-log-level-int severity)) 101 | (apply #'message args))) 102 | 103 | (defun mbsync-process-filter (proc string) 104 | "Filter for `mbsync', auto accepting certificates. 105 | Arguments PROC, STRING as in `set-process-filter'." 106 | (with-current-buffer (process-buffer proc) 107 | (unless (bound-and-true-p mbsync-process-filter-pos) 108 | (make-local-variable 'mbsync-process-filter-pos) 109 | (setq mbsync-process-filter-pos (point-min))) 110 | 111 | (save-excursion 112 | (let ((inhibit-read-only t)) 113 | (goto-char (point-max)) 114 | (insert (replace-regexp-in-string " " "\n" string)) 115 | 116 | ;; accept certificates 117 | (goto-char mbsync-process-filter-pos) 118 | (while (re-search-forward "Accept certificate?" nil t) 119 | (if mbsync-auto-accept-certs 120 | (process-send-string proc "y\n") 121 | (message "mbsync blocked, waiting for certificate acceptance"))))) 122 | 123 | (save-excursion 124 | ;; message progress 125 | (goto-char mbsync-process-filter-pos) 126 | (while (re-search-forward mbsync-status-line-re nil t) 127 | (setq mbsync-last-status (match-string 1)) 128 | (mbsync-log 'verbose "mbsync progress: %s" (match-string 1)))) 129 | 130 | (let (err-pos) 131 | (save-excursion 132 | ;; errors 133 | (goto-char mbsync-process-filter-pos) 134 | (while (re-search-forward (rx (or 135 | (and bol "Maildir error:" (* nonl) eol) 136 | (and bol "Error:" (* nonl) eol) 137 | (and (* nonl) ": unknown keyword " (* nonl) eol) 138 | (and bol "Cannot connect to " (* nonl) eol) 139 | (and bol "IMAP error:" (* nonl) eol) 140 | (and bol "Error from" (* nonl) eol) 141 | (and bol "No working address found for " (* nonl) eol) 142 | (and bol "gpg: decryption failed: " (* nonl) eol) 143 | (and bol "Skipping account " (* nonl) eol) )) 144 | nil t) 145 | (message "%s" (match-string 0)) 146 | (overlay-put (make-overlay (match-beginning 0) 147 | (match-end 0)) 148 | 'face 'mbsync-font-lock-error-face) 149 | (switch-to-buffer-other-window (current-buffer)) 150 | (setq err-pos (match-beginning 0)))) 151 | (when err-pos 152 | (goto-char err-pos))) 153 | 154 | (setq mbsync-process-filter-pos (point-max)))) 155 | 156 | (defun mbsync-sentinel (proc change) 157 | "Mail sync is over, message it then run `mbsync-exit-hook'. 158 | Arguments PROC, CHANGE as in `set-process-sentinel'." 159 | (when (eq (process-status proc) 'exit) 160 | (mbsync-log 'normal (format "mbsync is done: %s" change)) 161 | (when (not (eq (process-exit-status proc) 0)) 162 | (switch-to-buffer-other-window (process-buffer proc))) 163 | (run-hooks 'mbsync-exit-hook))) 164 | 165 | (defun mbsync-get-proc () 166 | "Get the running mbsync process (or nil if no such)." 167 | (let ((b (get-buffer "*mbsync*"))) 168 | (and (buffer-live-p b) 169 | (get-buffer-process b)))) 170 | 171 | ;;;###autoload 172 | (defun mbsync (&optional show-buffer) 173 | "Run the `mbsync' command, asynchronously, then run `mbsync-exit-hook'. 174 | If SHOW-BUFFER, also show the *mbsync* output." 175 | (interactive "P") 176 | (if (mbsync-get-proc) 177 | (message "Please wait, mbsync is already fetching, see buffer *mbsync* for details.") 178 | (let* ((dummy (when (get-buffer mbsync-buffer-name) 179 | (kill-buffer mbsync-buffer-name))) 180 | (proc (apply 'start-process 181 | mbsync-buffer-name 182 | mbsync-buffer-name 183 | mbsync-executable 184 | mbsync-args))) 185 | (set-process-filter proc 'mbsync-process-filter) 186 | (set-process-sentinel proc 'mbsync-sentinel))) 187 | (when show-buffer 188 | (set-window-buffer (selected-window) 189 | (process-buffer (mbsync-get-proc))))) 190 | 191 | (provide 'mbsync) 192 | 193 | ;;; mbsync.el ends here 194 | --------------------------------------------------------------------------------