eh-gnus-common.el

   1 ;;; eh-gnus-common.el --- Tumashu's gnus configuation file    -*- lexical-binding: t; -*-
   2
   3 ;; * Header
   4 ;; Copyright (c) 2008-2009, Andy Stewart
   5 ;;               2011-2019, Feng Shu
   6
   7 ;; Author: Andy Stewartf <lazycat.manatee@gmail.com>
   8 ;;         Feng Shu <tumashu@163.com>
   9 ;; URL: https://github.com/tumashu/emacs-helper
  10 ;; Version: 0.0.1
  11
  12 ;; This file is not part of GNU Emacs.
  13
  14 ;;; License:
  15
  16 ;; This program is free software; you can redistribute it and/or
  17 ;; modify it under the terms of the GNU General Public License
  18 ;; as published by the Free Software Foundation; either version 3
  19 ;; of the License, or (at your option) any later version.
  20 ;;
  21 ;; This program is distributed in the hope that it will be useful,
  22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 ;; GNU General Public License for more details.
  25 ;;
  26 ;; You should have received a copy of the GNU General Public License
  27 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  28 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  29 ;; Boston, MA 02110-1301, USA.
  30
  31 ;;; Commentary:
  32
  33 ;; * 简介                                                  :README:
  34 ;;  这个文件是tumashu个人专用的emacs配置文件，emacs中文用户可以参考。
  35
  36 ;;; Code:
  37
  38 ;; * 代码                                                      :code:
  39
  40 ;; 存储设置
  41 (defvar gnus-init-file "~/gnus/eh-gnus-personal.el")
  42 (defvar gnus-home-directory "~/gnus/")
  43 (defvar gnus-default-directory "~/gnus/")
  44 (defvar gnus-directory "~/gnus/")
  45 (defvar gnus-article-save-directory "~/gnus/Saved/")
  46 (defvar message-directory "~/gnus/Mail/")
  47 (defvar mm-default-directory "~/gnus/")
  48
  49 ;; Require
  50 (require 'gnus)
  51 (require 'gnus-cache)
  52 (require 'gnus-cite)
  53 (require 'gnus-agent)
  54 (require 'gnus-search)
  55 (require 'gnus-async)
  56 (require 'nntp)
  57 (require 'mm-encode)
  58 (require 'mm-decode)
  59 (require 'rfc2047)
  60 (require 'gnus-demon)
  61 (require 'eww)
  62 (require 'message)
  63 (require 'nnmairix)
  64 (require 'supercite)
  65
  66 ;; EBDB 设置
  67 (require 'ebdb)
  68 (require 'ebdb-i18n-chn)
  69
  70 (when (file-writable-p "~")
  71   (make-directory "~/gnus/ebdb/" t))
  72
  73 (setq ebdb-sources (list "~/gnus/ebdb/default"))
  74 (setq ebdb-search-transform-functions
  75       (list #'pyim-cregexp-build))
  76
  77 ;; ebdb-complete 设置
  78 (require 'ebdb-complete)
  79 (ebdb-complete-enable)
  80
  81 ;; ebdb-gnus 设置
  82 (require 'ebdb-gnus)
  83 (setq ebdb-gnus-window-size 0.25)
  84 (setq ebdb-gnus-auto-update-p
  85       (lambda ()
  86         (message
  87          (substitute-command-keys
  88           (concat "EBDB:  `\\[ebdb-mua-update-records]': 更新联系人，"
  89                   "`\\[ebdb-mua-snarf-article]': Snarf 联系人。"
  90                   "`\\[ebdb-mua-edit-sender-notes]': 备注联系人。")))
  91         'existing))
  92
  93 (defun eh-ebdb-insinuate-gnus ()
  94   (define-key gnus-summary-mode-map (kbd ";") nil)
  95   (define-key gnus-article-mode-map (kbd ";") nil)
  96   (define-key gnus-summary-mode-map (kbd "<f5>") #'ebdb-mua-update-records)
  97   (define-key gnus-article-mode-map (kbd "<f5>") #'ebdb-mua-update-records)
  98   (define-key gnus-summary-mode-map (kbd "<f6>") #'ebdb-mua-snarf-article)
  99   (define-key gnus-article-mode-map (kbd "<f6>") #'ebdb-mua-snarf-article)
 100   (define-key gnus-summary-mode-map (kbd "<f7>") #'ebdb-mua-edit-sender-notes)
 101   (define-key gnus-article-mode-map (kbd "<f7>") #'ebdb-mua-edit-sender-notes))
 102
 103 (advice-add 'ebdb-insinuate-gnus :after #'eh-ebdb-insinuate-gnus)
 104
 105 ;; ebdb-message 设置
 106 (require 'ebdb-message)
 107 (setq ebdb-message-window-size 0.25)
 108 (setq ebdb-message-auto-update-p ebdb-gnus-auto-update-p)
 109
 110 ;; 使用 notmush 搜索邮件
 111
 112 ;; Notmuch 使用 Xapian 创建 index, Xapian (version < 1.5) 需要设置下面
 113 ;; 的环境变量来启用 CJK 功能：
 114 ;;
 115 ;;     export XAPIAN_CJK_NGRAM=1
 116 ;;
 117 ;; Xapian (version >= 1.5) 可以自动识别 CJK, 但要求编译的时候启用
 118 ;; LIBICU.
 119 ;;
 120 ;; 记得使用下面的命令来重建邮件索引。
 121 ;;
 122 ;;     notmuch reindex "*"
 123 ;;
 124 (setq gnus-search-notmuch-program "notmuch")
 125 (setq gnus-search-default-engines
 126       '((nnimap . gnus-search-imap)
 127         (nnml   . gnus-search-notmuch)))
 128
 129 ;; 如果命令 'notmuch search --format=text --output=files hello' 得到的
 130 ;; 一个结果是: '/home/feng/gnus/Mail/mail/misc/9407', 而当前搜索的组名
 131 ;; 称是 mail.misc, 那么下面的变量应该设置为
 132 ;; "/home/feng/gnus/Mail/". 注意，这个变量设置不对，不显示搜到邮件。
 133 (setq gnus-search-notmuch-remove-prefix
 134       (expand-file-name message-directory))
 135
 136 ;; 邮件分类设置
 137 (setq nnmail-treat-duplicates 'delete
 138       nnmail-split-fancy-match-partial-words t
 139       nnmail-mail-splitting-decodes t
 140       nnmail-mail-splitting-charset 'utf-8
 141       ;; 使用 nnimap 时，不用默认的分类方法。
 142       nnimap-split-methods nil)
 143
 144 (setq gnus-keep-backlog 1000) ;启用 backlog 功能，163 和 QQ imap 速度太慢了。
 145
 146 ;; 设置一个组的最大 article 数，这个设置对 nnimap 163邮箱很有用，因为
 147 ;; 如果没有这个设置，进入 163 INBOX 会卡死 emacs.
 148 (setq gnus-newsgroup-maximum-articles 100000)
 149
 150 ;; 使用准确率较高的地址提取函数
 151 (setq gnus-extract-address-components
 152       'mail-extract-address-components)
 153
 154 ;; 默认禁用 nnfolder
 155 (setq gnus-message-archive-group nil)
 156
 157 ;; 设置 message-mode 发信的方式，这里默认使用 /usr/sbin/sendmail.
 158 ;; 在 `gnus-posting-styles' 中设置 "X-Message-SMTP-Method" 邮件头可以实现
 159 ;; 更为复杂的邮件发送方式。
 160 (setq message-send-mail-function 'message-smtpmail-send-it)
 161
 162 ;; Message 自动设置 "X-Message-SMTP-Method" 功能。
 163 (defun eh-message-server-alist-function ()
 164   (let* ((from (cadr (mail-extract-address-components
 165                       (save-restriction
 166                         (widen)
 167                         (message-narrow-to-headers-or-head)
 168                         (message-fetch-field "From")))))
 169          (str (replace-regexp-in-string "^.*@" "" from)))
 170     (when (> (length str) 0)
 171       (format "smtp smtp.%s 465 %s" str from))))
 172
 173 (setq message-server-alist '((eh-message-server-alist-function)))
 174
 175 ;; 设置gnus默认编码: 如果常与国外联系，可以设置为utf-8
 176 ;; 如果只在本国使用，可以设置为本地编码，比如: gbk
 177 (setq gnus-default-charset 'gbk)
 178
 179 ;; 根据method来确定编码
 180 (setq gnus-group-name-charset-method-alist
 181       '(((nntp "news.newsfan.net") . gbk)
 182         ((nntp "news.cn99.com") . gbk)))
 183
 184 ;; 根据组名称来确定组名称解析使用的编码
 185 (setq gnus-group-name-charset-group-alist
 186       '((".*" . gbk)))
 187
 188 ;; 确定组默认使用的编码。
 189 (setq gnus-group-charset-alist
 190       '((".*" . gbk)))
 191
 192 ;; 如果还有乱码，手动调整
 193 (setq gnus-summary-show-article-charset-alist
 194       '((1 . gbk)
 195         (2 . utf-8)
 196         (3 . big5)
 197         (4 . utf-7)))
 198
 199 ;; 邮件MIME类型设置不正确时，gnus的处理方式。
 200 (setq gnus-newsgroup-ignored-charsets
 201       '(unknown-8bit x-unknown x-gbk))
 202
 203 ;; 设置邮件附件文件名的编码方式以及邮件subject的编码方式
 204 (defalias 'mail-header-encode-parameter 'rfc2047-encode-parameter)
 205 (add-to-list 'rfc2047-charset-encoding-alist '(gbk . B))
 206 (add-to-list 'rfc2047-charset-encoding-alist '(gb18030 . B))
 207
 208 ;; 常规设置
 209 (setq gnus-agent t)                                 ; 开启agent
 210 (setq read-mail-command 'gnus)                      ; 使用gnus阅读邮件
 211 (setq mail-user-agent 'gnus-user-agent)             ; 使用gnus发送邮件
 212 (setq gnus-inhibit-startup-message t)               ; 关闭启动时的画面
 213 (setq gnus-novice-user nil)                         ; 关闭新手设置, 不进行确认
 214 (setq gnus-expert-user t)                           ; 不询问用户
 215 (setq gnus-show-threads t)                          ; 显示邮件threads
 216 (setq gnus-interactive-exit t)                      ; 退出时进行交互式询问
 217 (setq gnus-use-dribble-file t)                      ; 创建恢复文件
 218 (setq gnus-always-read-dribble-file t)              ; 读取恢复文件
 219 (setq gnus-asynchronous t)                          ; 异步操作
 220 (setq gnus-large-newsgroup 2000)                    ; 设置大容量的新闻组默认显示的大小
 221 (setq gnus-large-ephemeral-newsgroup nil)           ; 设置临时新闻组默认显示的大小
 222 (setq gnus-read-active-file 'some)
 223 (setq gnus-nov-is-evil nil)
 224 (setq gnus-summary-ignore-duplicates t)             ; 忽略具有相同ID的消息
 225 (setq gnus-treat-fill-long-lines t)                 ; 自动折行
 226 (setq message-confirm-send t)                       ; 发邮件前需要确认（防止误发）
 227 (setq message-kill-buffer-on-exit t)                ; 发送邮件后删除buffer
 228 (setq message-syntax-checks '((sender . disabled))) ; 语法检查
 229 (setq nnmail-expiry-wait 7)                         ; 邮件自动删除的期限 (单位: 天)
 230 (setq nnmairix-allowfast-default t)                 ; 加快进入搜索结果的组
 231 (setq gc-cons-threshold 3500000)                    ; 加快 gnus 的速度
 232 (setq gnus-use-cross-reference t)                   ; 开启交叉索引
 233 (setq gnus-summary-display-while-building 50)       ; 生成 summary 时,每50封显示一下
 234
 235 ;; 进入 summer 模式时，禁止自动选择第一个article,
 236 ;; 这样设置主要是因为有些 article 下载速度极慢，
 237 ;; 会降低响应速度
 238 (setq gnus-auto-select-first nil)
 239 (setq gnus-auto-select-next nil)
 240
 241 ;; 设置 gnus 启动时,组级别大于3的不自动更新。
 242 ;; 当你添加了许多速度慢的组时，比如 rss,imap 等，启动速度会相当慢。这时你
 243 ;; 可以把它们的组级别设置为大于3的值，这样启动时就不自动更新了。
 244 ;; 当你需要更新这些组的时候，使用 "4-g" "5-g" 等快捷键
 245 (setq gnus-activate-level 3)
 246
 247 ;; 双窗口布局(水平)
 248 (gnus-add-configuration
 249  '(article
 250    (vertical 1.0
 251              (summary 0.25 point)
 252              (article 1.0))))
 253
 254 ;; 设置图片显示方式
 255 (setq mm-inline-large-images t)
 256 (add-to-list 'mm-attachment-override-types "image/*")
 257
 258 ;; 设置summary缓冲区的显示格式
 259 (setq gnus-extra-headers '(To From))
 260 (setq nnmail-extra-headers gnus-extra-headers)
 261 (setq gnus-summary-gather-subject-limit 'fuzzy)
 262 (setq gnus-summary-make-false-root 'adopt)
 263 (setq gnus-summary-line-format "%U%R%z %&user-date;  %-16,16a %5k%I%B%s\n")
 264
 265 ;; 设置 threads 的样式
 266 (setq gnus-thread-indent-level 0)
 267 (setq gnus-summary-same-subject "")
 268 (setq gnus-sum-thread-tree-indent "  ")
 269 (setq gnus-sum-thread-tree-single-indent "  ")
 270 (setq gnus-sum-thread-tree-root "  ")
 271 (setq gnus-sum-thread-tree-false-root "  ")
 272 (setq gnus-sum-thread-tree-vertical "   |")
 273 (setq gnus-sum-thread-tree-leaf-with-other "   |-> ")
 274 (setq gnus-sum-thread-tree-single-leaf "    `-> ")
 275
 276 ;; 设置 `gnus-summary-line-format' 中的 %&user-date;
 277 (setq gnus-user-date-format-alist
 278       '(((gnus-seconds-today) . " %H:%M")
 279         ((gnus-seconds-month) . "  %d日")
 280         ((gnus-seconds-year)  . " %m-%d")
 281         (t . "%Y年")))
 282
 283 ;; 将邮件的发出时间转换为本地时间
 284 (add-hook 'gnus-article-prepare-hook #'gnus-article-date-local)
 285
 286 ;; 跟踪组的时间轴
 287 (add-hook 'gnus-select-group-hook #'gnus-group-set-timestamp)
 288
 289 (defun eh-gnus-summary-setup ()
 290   (interactive)
 291   ;; summary buffer 行距设置
 292   (setq line-spacing 5)
 293
 294   ;; Highlight 当前行
 295   (hl-line-mode 1)
 296
 297   ;; 重新定义键盘绑定
 298   (local-set-key (kbd "SPC")
 299                  (lambda ()
 300                    (interactive)
 301                    (gnus-summary-next-page)
 302                    (move-beginning-of-line 1)))
 303   (local-set-key (kbd "C-p")
 304                  (lambda ()
 305                    (interactive)
 306                    (delete-other-windows)
 307                    (forward-line -1)))
 308   (local-set-key (kbd "C-n")
 309                  (lambda ()
 310                    (interactive)
 311                    (delete-other-windows)
 312                    (forward-line 1)))
 313   (local-set-key (kbd "<up>")
 314                  (lambda ()
 315                    (interactive)
 316                    (delete-other-windows)
 317                    (forward-line -1)))
 318   (local-set-key (kbd "<down>")
 319                  (lambda ()
 320                    (interactive)
 321                    (delete-other-windows)
 322                    (forward-line 1))))
 323
 324 (add-hook 'gnus-summary-mode-hook #'eh-gnus-summary-setup)
 325
 326 ;; visual
 327 (setq gnus-treat-emphasize t
 328       gnus-treat-buttonize t
 329       gnus-treat-buttonize-head 'head
 330       gnus-treat-unsplit-urls 'last
 331       gnus-treat-leading-whitespace 'head
 332       gnus-treat-highlight-citation t
 333       gnus-treat-highlight-signature t
 334       gnus-treat-strip-trailing-blank-lines t
 335       gnus-treat-strip-cr t
 336       gnus-treat-overstrike nil
 337       gnus-treat-display-x-face t
 338       gnus-treat-display-face t
 339       gnus-treat-display-smileys nil
 340       gnus-treat-x-pgp-sig 'head)
 341
 342 ;; 设置邮件报头显示的信息
 343 (setq gnus-visible-headers
 344       (mapconcat 'regexp-quote
 345                  '("From:" "Newsgroups:" "Subject:" "Date:"
 346                    "Organization:" "To:" "Cc:" "Followup-To" "Gnus-Warnings:"
 347                    "X-Sent:" "X-URL:" "User-Agent:" "X-Newsreader:"
 348                    "X-Mailer:" "Reply-To:" "X-Spam:" "X-Spam-Status:" "X-Now-Playing"
 349                    "X-Attachments" "X-Diagnostic" "X-RSS-URL")
 350                  "\\|"))
 351
 352 ;; 设置邮件日期显示格式,使用两行日期，一行具体日期时间，
 353 ;; 另一行显示article, 距现在多长时间
 354 (setq gnus-article-date-headers '(user-defined))
 355 (setq gnus-article-time-format
 356       (lambda (time)
 357         (concat "X-Sent:   "
 358                 (format-time-string "%Y年%m月%d日 星期%u %R" time)
 359                 "\n"
 360                 "X-Lasped: "
 361                 (article-lapsed-string time))))
 362
 363 ;; 用 Supercite 显示多种多样的引文形式
 364 (setq sc-attrib-selection-list nil
 365       sc-auto-fill-region-p nil
 366       sc-blank-lines-after-headers 1
 367       sc-citation-delimiter-regexp "[>]+\\|\\(: \\)+"
 368       sc-cite-blank-lines-p nil
 369       sc-confirm-always-p nil
 370       sc-electric-references-p nil
 371       sc-fixup-whitespace-p t
 372       sc-nested-citation-p nil
 373       sc-preferred-header-style 4
 374       sc-use-only-preference-p nil)
 375
 376 ;; 构建 threads 时抓取旧文章标题,
 377 ;; 注意： 网速不快时不要使用这个选项。
 378 (setq gnus-fetch-old-headers nil)
 379
 380 ;; 聚集 threads 的方式
 381 (setq gnus-summary-thread-gathering-function
 382       'gnus-gather-threads-by-subject)
 383
 384 ;; Thread root 排序
 385 (setq gnus-thread-sort-functions
 386       '(gnus-thread-sort-by-most-recent-number
 387         gnus-thread-sort-by-most-recent-date))
 388
 389 ;; Subthread 排序
 390 (setq gnus-subthread-sort-functions
 391       '(gnus-thread-sort-by-number
 392         gnus-thread-sort-by-date))
 393
 394 ;; 自动跳到第一个没有阅读的组
 395 (add-hook 'gnus-switch-on-after-hook
 396           #'gnus-group-first-unread-group)
 397
 398 (add-hook 'gnus-summary-exit-hook
 399           #'gnus-group-first-unread-group)
 400
 401
 402 ;; * Footer
 403 (provide 'eh-gnus-common)
 404
 405 ;; Local Variables:
 406 ;; coding: utf-8-unix
 407 ;; End:
 408
 409 ;;; eh-gnus-common.el ends here