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 (defconst eweouz-version "0.1")
  24 (defconst eweouz-buffer-name "*EWEOUZ*")
  25
  26 (setq eweouz-helper-dirs '("/usr/lib/eweouz" "/usr/local/lib/eweouz"))
  27
  28 (defvar eweouz-dump-path (locate-file "eweouz-dump-addressbook"
  29                                       eweouz-helper-dirs
  30                                       nil
  31                                       'executable))
  32
  33 (defvar eweouz-write-path (locate-file "eweouz-write-addressbook"
  34                                        eweouz-helper-dirs
  35                                        nil
  36                                        'executable))
  37
  38 (defvar eweouz-buffer nil)
  39 (defvar eweouz-pop-up-target-lines 5)
  40
  41 (defun eweouz-search-do (func string)
  42   "Search for the simple string STRING in all fields"
  43   (with-temp-buffer
  44     (call-process eweouz-dump-path nil (current-buffer) t string)
  45     (set-text-properties (point-min) (point-max) nil nil)
  46     (goto-char (point-min))
  47     (message (format "%s" (point)))
  48     (while (looking-at "\n*BEGIN:VCARD")
  49       (let ((m-start (point)))
  50         (message (format "%s" (point)))
  51         (search-forward-regexp "^END:VCARD")
  52         (funcall func (vcard-parse-string (buffer-substring m-start (point))))))))
  53
  54 ;;;###autoload
  55 (defun eweouz-complete (&optional start-pos)
  56   (interactive)
  57   (eweouz-erase-buffer)
  58   (let* ((end (point))
  59          (beg (or start-pos
  60                   (save-excursion
  61                     (re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*")
  62                     (goto-char (match-end 0))
  63                     (point))))
  64          (orig (buffer-substring beg end))
  65          (typed (downcase orig))
  66          (match-recs '()))
  67     (eweouz-search-do '(lambda (x) (add-to-list 'match-recs x)) typed)
  68     (message (format "%s" match-recs))
  69     (message (format "%d" (length match-recs)))
  70     (cond ((= 0 (length match-recs))
  71            (message "No matching records"))
  72           ((= 1 (length match-recs))
  73           ; Just one match; insert it
  74            (progn
  75              (delete-region beg end)
  76              (insert (vcard-format-sample-get-name (car match-recs)))))
  77           ((< 1 (length match-recs))
  78            ;; For now, just display the records and leave the user to
  79            ;; complete
  80            (save-excursion
  81              (set-buffer (get-buffer-create eweouz-buffer-name))
  82              (mapcar '(lambda (x) (insert (format "%s\n"
  83                                                   (vcard-format-sample-get-name x)))) match-recs)
  84              (eweouz-pop-up-eweouz-buffer))))))
  85
  86 ;
  87 ; Mostly stolen from bbdb-pop-up-bbdb-buffer
  88
  89 (defun eweouz-pop-up-eweouz-buffer (&optional horiz-predicate)
  90  (let ((b (current-buffer)))
  91     (if (get-buffer-window eweouz-buffer-name)
  92         nil
  93       (let* ((first-window (selected-window))
  94              (tallest-window first-window)
  95              (window first-window))
  96         ;; find the tallest window...
  97         (while (not (eq (setq window (previous-window window)) first-window))
  98           (if (> (window-height window) (window-height tallest-window))
  99               (setq tallest-window window)))
 100         ;; select it and split it...
 101         (select-window tallest-window)
 102         (let ((size (min
 103                      (- (window-height tallest-window)
 104                         window-min-height 1)
 105                      (- (window-height tallest-window)
 106                         (max window-min-height
 107                              (1+ eweouz-pop-up-target-lines))))))
 108           (split-window tallest-window
 109                         (if (> size 0) size window-min-height)))
 110         (if (memq major-mode
 111                   '(gnus-Group-mode gnus-Subject-mode gnus-Article-mode))
 112             (goto-char (point-min)))  ; make gnus happy...
 113         ;; goto the bottom of the two...
 114         (select-window (next-window))
 115         ;; make it display *EWEOUZ*...
 116         (let ((pop-up-windows nil))
 117           (switch-to-buffer (get-buffer-create eweouz-buffer-name)))
 118         ;; select the original window we were in...
 119         (select-window first-window)))
 120     ;; and make sure the current buffer is correct as well.
 121     (set-buffer b)
 122     nil))
 123
 124 (defun eweouz-erase-buffer ()
 125   (save-excursion
 126     (set-buffer (get-buffer-create eweouz-buffer-name))
 127     (erase-buffer)))
 128
 129 ;;;###autoload
 130 (defun eweouz (string)
 131   (interactive "MSearch for: ")
 132   "Search all entries for the simple string STRING in all fields"
 133   (eweouz-erase-buffer)
 134   (eweouz-search-do 'eweouz-show string)
 135   (eweouz-pop-up-eweouz-buffer))
 136
 137 (defun eweouz-show (record)
 138   "Display an entry in the current buffer"
 139   (save-excursion
 140     (set-buffer (get-buffer-create eweouz-buffer-name))
 141     (insert (vcard-pretty-print record))))
 142
 143 (defun eweouz-add-sender ()
 144   "Add sender of current message"
 145   (interactive)
 146   (save-excursion
 147     (set-buffer gnus-article-buffer)
 148     (eweouz-do-add (mail-header-parse-address (gnus-fetch-field "From")))))
 149
 150 (defun eweouz-do-add (record)
 151   (interactive)
 152   (let* ((email (car record))
 153          (name (cdr record)))
 154     (message (format "%s" record))
 155     (call-process eweouz-write-path nil nil nil "--id" "new" "--full-name" name
 156                   "--emails" email)))
 157
 158 (defun eweouz-insinuate-gnus ()
 159   "Call this function to hook EWEOUZ into Gnus."
 160   (define-key gnus-summary-mode-map ":" 'eweouz-add-sender))
 161
 162 (defun eweouz-insinuate-sendmail ()
 163   "Call this function to hook EWEOUZ into sendmail (M-x mail)."
 164   (define-key mail-mode-map [C-tab] 'eweouz-complete))
 165
 166 (defun eweouz-insinuate-message ()
 167   "Call this function to hook EWEOUZ into message-mode."
 168   (define-key message-mode-map [C-tab] 'eweouz-complete))
 169
 170 (defun eweouz-insinuate-wl ()
 171   (define-key wl-draft-mode-map [C-tab] 'eweouz-complete)
 172   (define-key wl-summary-mode-map ":" 'eweouz-add-sender-wl))
 173
 174 (defun eweouz-add-sender-wl ()
 175   "Add sender of current message"
 176   (interactive)
 177   (save-excursion
 178     (set-buffer wl-message-buffer)
 179     (let* ((from (std11-extract-address-components (std11-field-body "From")))
 180            (record (list (cons 'email (cadr from))
 181                          (cons 'name (car from)))))
 182       (eweouz-do-add record))))
 183
 184 (require 'vcard)
 185 (provide 'eweouz)
 186