git.shemshak.org - ~bandali/configs/blob - lisp/bbdb/bbdb-ispell.el

   1 ;;; bbdb-ispell.el --- export names from BBDB to personal ispell dictionaries -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2011-2017  Free Software Foundation, Inc.
   4
   5 ;; Author: Ivan Kanis <ivan.kanis@googlemail.com>
   6
   7 ;; This file is part of the Insidious Big Brother Database (aka BBDB),
   8
   9 ;; BBDB is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; BBDB is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with BBDB.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23 ;;
  24 ;; Names are often not recognized by the standard ispell dictionaries.
  25 ;; `bbdb-ispell-export' exports the names from your BBDB records to your
  26 ;; personal ispell dictionaries.
  27 ;; The personal dictionaries are in `bbdb-ispell-dictionary-list'
  28 ;; The BBDB fields for this are in `bbdb-ispell-field-list'.
  29 ;; Exclude words via `bbdb-ispell-min-word-length' and `bbdb-ispell-ignore-re'.
  30 ;;
  31 ;; Bugs:
  32 ;; Save your personal directories before running this code.  I had my
  33 ;; dictionary truncated while debugging.  It shouldn't happen
  34 ;; but better be safe than sorry...
  35 ;;
  36 ;; See the BBDB info manual for documentation.
  37
  38 ;;; Code:
  39
  40 (require 'ispell)
  41 (require 'bbdb)
  42
  43 (defcustom bbdb-ispell-dictionary-list '("default")
  44   "List of ispell personal dictionaries.
  45 Allowed elements are as in the return value of `ispell-valid-dictionary-list'."
  46   :group 'bbdb-utilities-ispell
  47   :type (cons 'set (mapcar (lambda (dict) `(string ,dict))
  48                            (ispell-valid-dictionary-list))))
  49
  50 (defcustom bbdb-ispell-field-list '(name organization aka)
  51   "List of fields of each BBDB record considered for the personal dictionary."
  52   :group 'bbdb-utilities-ispell
  53   :type (list 'repeat
  54               (append '(choice) (mapcar (lambda (field) `(const ,field))
  55                                         '(name organization affix aka address))
  56                       '((symbol :tag "xfield")))))
  57
  58 (defcustom bbdb-ispell-min-word-length 3
  59   "Words with fewer characters are ignored."
  60   :group 'bbdb-utilities-ispell
  61   :type 'number)
  62
  63 (defcustom bbdb-ispell-ignore-re "[^[:alpha:]]"
  64   "Words matching this regexp are ignored."
  65   :group 'bbdb-utilities-ispell
  66   :type 'regexp)
  67
  68 ;; Internal variable
  69 (defvar bbdb-ispell-word-list nil
  70   "List of words extracted from the BBDB records.")
  71
  72 ;;;###autoload
  73 (defun bbdb-ispell-export ()
  74   "Export BBDB records to ispell personal dictionaries."
  75   (interactive)
  76   (message "Exporting to personal dictionary...")
  77   (let (bbdb-ispell-word-list)
  78     ;; Collect words from BBDB records.
  79     (dolist (record (bbdb-records))
  80       (dolist (field bbdb-ispell-field-list)
  81         (bbdb-ispell-collect-words (bbdb-record-field record field))))
  82
  83     ;; Update personal dictionaries
  84     (dolist (dict (or bbdb-ispell-dictionary-list '("default")))
  85       (ispell-change-dictionary dict)
  86       ;; Initialize variables and dicts alists
  87       (ispell-set-spellchecker-params)
  88       (ispell-init-process)
  89       ;; put in verbose mode
  90       (ispell-send-string "%\n")
  91       (let (new)
  92         (dolist (word (delete-dups bbdb-ispell-word-list))
  93           (ispell-send-string (concat "^" word "\n"))
  94           (while (progn
  95                    (ispell-accept-output)
  96                    (not (string= "" (car ispell-filter)))))
  97           ;; remove extra \n
  98           (setq ispell-filter (cdr ispell-filter))
  99           (when (and ispell-filter
 100                      (listp ispell-filter)
 101                      (not (eq (ispell-parse-output (car ispell-filter)) t)))
 102             ;; ok the word doesn't exist, add it
 103             (ispell-send-string (concat "*" word "\n"))
 104             (setq new t)))
 105         (when new
 106           ;; Save dictionary:
 107           ;; aspell doesn't tell us when it completed the saving.
 108           ;; So we send it another word for spellchecking.
 109           (ispell-send-string "#\n^hello\n")
 110           (while (progn
 111                    (ispell-accept-output)
 112                    (not (string= "" (car ispell-filter)))))))))
 113   (message "Exporting to personal dictionary...done"))
 114
 115 (defun bbdb-ispell-collect-words (field)
 116   "Parse BBDB FIELD and collect words in `bbdb-ispell-word-list'."
 117   ;; Ignore everything in FIELD that is not a string or a sequence.
 118   (cond ((stringp field)
 119          (dolist (word (split-string field))
 120            (if (and (>= (length word) bbdb-ispell-min-word-length)
 121                     (not (string-match bbdb-ispell-ignore-re word)))
 122                (push word bbdb-ispell-word-list))))
 123         ((sequencep field) (mapc 'bbdb-ispell-collect-words field))))
 124
 125 (provide 'bbdb-ispell)
 126
 127 ;;; bbdb-ispell.el ends here