err.no Git - eweouz/blob - lisp/eweouz.el

   1 ;;; -*- Mode:Emacs-Lisp -*-
   2
   3 ;;; This file is the core of the eweouz, an interface to the
   4 ;;; evolution-data-server, somewhat similar to BBDB.
   5
   6 ;;;  copyright (c) 2008 Tollef Fog Heen <tfheen@err.no>
   7 ;;;
   8 ;;; eweouz is free software; you can redistribute it and/or modify it
   9 ;;; under the terms of the GNU General Public License version 2 as
  10 ;;; published by the Free Software Foundation.
  11 ;;;
  12 ;;; eweouz is distributed in the hope that it will be useful, but
  13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 ;;; General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License
  18 ;;; along with this program; if not, write to the Free Software
  19 ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  20 ;;; 02110-1301 USA.
  21 ;;;
  22
  23 (require 'cl)
  24
  25 (defconst eweouz-version "0.3")
  26 (defconst eweouz-buffer-name "*EWEOUZ*")
  27
  28 (setq eweouz-helper-dirs '("/usr/lib/eweouz" "/usr/local/lib/eweouz"))
  29
  30 (defvar eweouz-dump-path (locate-file "eweouz-dump-addressbook"
  31                                       eweouz-helper-dirs
  32                                       nil
  33                                       'executable))
  34
  35 (defvar eweouz-write-path (locate-file "eweouz-write-addressbook"
  36                                        eweouz-helper-dirs
  37                                        nil
  38                                        'executable))
  39
  40 (defvar eweouz-buffer nil)
  41 (defvar eweouz-pop-up-target-lines 5)
  42
  43 (defun eweouz-search-do (func string &optional max-matches)
  44   "Search for the simple string STRING in all fields"
  45   (let ((i 0))
  46     (with-temp-buffer
  47       (call-process eweouz-dump-path nil (list (current-buffer) nil) t string)
  48       (set-text-properties (point-min) (point-max) nil nil)
  49       (goto-char (point-min))
  50       (message (format "%s" (point)))
  51       (while (and (looking-at "\n*BEGIN:VCARD") (or (eq max-matches nil)
  52                                                  (< i max-matches)))
  53         (let ((m-start (point)))
  54           (incf i)
  55           (message (format "%s" (point)))
  56           (search-forward-regexp "^END:VCARD")
  57           (funcall func (vcard-parse-string (buffer-substring m-start (point)))))))))
  58
  59 ;;;###autoload
  60 (defun eweouz-complete (&optional start-pos)
  61   (interactive)
  62   (eweouz-erase-buffer)
  63   (let* ((end (point))
  64          (beg (or start-pos
  65                   (save-excursion
  66                     (re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*")
  67                     (goto-char (match-end 0))
  68                     (point))))
  69          (orig (buffer-substring beg end))
  70          (typed (downcase orig))
  71          (match-recs '()))
  72     (eweouz-search-do '(lambda (x) (add-to-list 'match-recs x)) typed)
  73     (message (format "%s" match-recs))
  74     (message (format "%d" (length match-recs)))
  75     (cond ((= 0 (length match-recs))
  76            (message "No matching records"))
  77           ((= 1 (length match-recs))
  78           ; Just one match; insert it
  79            (progn
  80              (delete-region beg end)
  81              (insert (vcard-format-sample-get-name (car match-recs)))))
  82           ((< 1 (length match-recs))
  83            ;; For now, just display the records and leave the user to
  84            ;; complete
  85            (save-excursion
  86              (set-buffer (get-buffer-create eweouz-buffer-name))
  87              (mapcar '(lambda (x) (insert (format "%s\n"
  88                                                   (vcard-format-sample-get-name x)))) match-recs)
  89              (eweouz-pop-up-eweouz-buffer))))))
  90
  91 ;
  92 ; Mostly stolen from bbdb-pop-up-bbdb-buffer
  93
  94 (defun eweouz-pop-up-eweouz-buffer (&optional horiz-predicate)
  95  (let ((b (current-buffer)))
  96     (if (get-buffer-window eweouz-buffer-name)
  97         nil
  98       (let* ((first-window (selected-window))
  99              (tallest-window first-window)
 100              (window first-window))
 101         ;; find the tallest window...
 102         (while (not (eq (setq window (previous-window window)) first-window))
 103           (if (> (window-height window) (window-height tallest-window))
 104               (setq tallest-window window)))
 105         ;; select it and split it...
 106         (select-window tallest-window)
 107         (let ((size (min
 108                      (- (window-height tallest-window)
 109                         window-min-height 1)
 110                      (- (window-height tallest-window)
 111                         (max window-min-height
 112                              (1+ eweouz-pop-up-target-lines))))))
 113           (split-window tallest-window
 114                         (if (> size 0) size window-min-height)))
 115         (if (memq major-mode
 116                   '(gnus-Group-mode gnus-Subject-mode gnus-Article-mode))
 117             (goto-char (point-min)))  ; make gnus happy...
 118         ;; goto the bottom of the two...
 119         (select-window (next-window))
 120         ;; make it display *EWEOUZ*...
 121         (let ((pop-up-windows nil))
 122           (switch-to-buffer (get-buffer-create eweouz-buffer-name)))
 123         ;; select the original window we were in...
 124         (select-window first-window)))
 125     ;; and make sure the current buffer is correct as well.
 126     (set-buffer b)
 127     nil))
 128
 129 (defun eweouz-erase-buffer ()
 130   (save-excursion
 131     (set-buffer (get-buffer-create eweouz-buffer-name))
 132     (erase-buffer)))
 133
 134 ;;;###autoload
 135 (defun eweouz (string)
 136   (interactive "MSearch for: ")
 137   "Search all entries for the simple string STRING in all fields"
 138   (eweouz-erase-buffer)
 139   (eweouz-search-do 'eweouz-show string)
 140   (eweouz-pop-up-eweouz-buffer))
 141
 142 (defun eweouz-show (record)
 143   "Display an entry in the current buffer"
 144   (save-excursion
 145     (set-buffer (get-buffer-create eweouz-buffer-name))
 146     (insert (vcard-pretty-print record))))
 147
 148 (defun eweouz-add-sender-gnus ()
 149   "Add sender of current message"
 150   (interactive)
 151   (save-excursion
 152     (set-buffer gnus-article-buffer)
 153     (let* ((from (mail-header-parse-address (gnus-fetch-field "From")))
 154            (email (car from))
 155            (name (cdr from))
 156            (record (or (eweouz-search-do 'identity email 1)
 157                        (eweouz-search-do 'identity name 1))))
 158       (if record
 159           (eweouz-do-update record name email)
 160         (eweouz-do-add from)))))
 161
 162 (defun eweouz-do-update (record name email)
 163   (interactive)
 164   (let ((uid (cadr (assoc '("uid") record))))
 165     (message (format "%s %s %s" uid name email))
 166     (call-process eweouz-write-path nil nil nil "--id" uid "--full-name" name
 167                   "--emails" email)))
 168
 169 (defun eweouz-do-add (record)
 170   (interactive)
 171   (let* ((email (car record))
 172          (name (cdr record)))
 173     (message (format "%s" record))
 174     (call-process eweouz-write-path nil nil nil "--id" "new" "--full-name" name
 175                   "--emails" email)))
 176
 177 (defun eweouz-insinuate-gnus ()
 178   "Call this function to hook EWEOUZ into Gnus."
 179   (define-key gnus-summary-mode-map ":" 'eweouz-add-sender-gnus))
 180
 181 (defun eweouz-insinuate-sendmail ()
 182   "Call this function to hook EWEOUZ into sendmail (M-x mail)."
 183   (define-key mail-mode-map [C-tab] 'eweouz-complete))
 184
 185 (defun eweouz-insinuate-message ()
 186   "Call this function to hook EWEOUZ into message-mode."
 187   (define-key message-mode-map [C-tab] 'eweouz-complete))
 188
 189 (defun eweouz-insinuate-wl ()
 190   (define-key wl-draft-mode-map [C-tab] 'eweouz-complete)
 191   (define-key wl-summary-mode-map ":" 'eweouz-add-sender-wl))
 192
 193 (defun eweouz-add-sender-wl ()
 194   "Add sender of current message"
 195   (interactive)
 196   (wl-summary-set-message-buffer-or-redisplay)
 197   (set-buffer (wl-message-get-original-buffer))
 198   (let* ((from (std11-extract-address-components (std11-field-body "From")))
 199          (name (cadr from))
 200          (email (car from))
 201          (record (cons name email)))
 202     (eweouz-do-add record)))
 203
 204 (require 'vcard)
 205 (provide 'eweouz)
 206