|
|
@@ -0,0 +1,477 @@
|
|
|
+;;; org-contacts.el --- Contacts management
|
|
|
+
|
|
|
+;; Copyright (C) 2010, 2011 Julien Danjou <julien@danjou.info>
|
|
|
+
|
|
|
+;; Author: Julien Danjou <julien@danjou.info>
|
|
|
+;; Keywords: outlines, hypermedia, calendar
|
|
|
+;;
|
|
|
+;; This file is NOT part of GNU Emacs.
|
|
|
+;;
|
|
|
+;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
|
+;; it under the terms of the GNU General Public License as published by
|
|
|
+;; the Free Software Foundation, either version 3 of the License, or
|
|
|
+;; (at your option) any later version.
|
|
|
+
|
|
|
+;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
+;; GNU General Public License for more details.
|
|
|
+
|
|
|
+;; You should have received a copy of the GNU General Public License
|
|
|
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
|
|
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
+;;
|
|
|
+;;; Commentary:
|
|
|
+
|
|
|
+;; This file contains the code for managing your contacts into Org-mode.
|
|
|
+
|
|
|
+;; To enter new contacts, you can use `org-capture' and a template just like
|
|
|
+;; this:
|
|
|
+
|
|
|
+;; ("c" "Contacts" entry (file "~/Org/contacts.org")
|
|
|
+;; "* %(org-contacts-template-name)
|
|
|
+;; :PROPERTIES:
|
|
|
+;; :EMAIL: %(org-contacts-template-email)
|
|
|
+;; :END:")))
|
|
|
+;;
|
|
|
+;;; Code:
|
|
|
+
|
|
|
+(eval-and-compile
|
|
|
+ (require 'org)
|
|
|
+ (require 'gnus)
|
|
|
+ (require 'gnus-art))
|
|
|
+
|
|
|
+(defgroup org-contacts nil
|
|
|
+ "Options concerning contacts management."
|
|
|
+ :group 'org)
|
|
|
+
|
|
|
+(defcustom org-contacts-files nil
|
|
|
+ "List of Org files to use as contacts source.
|
|
|
+If set to nil, all your Org files will be used."
|
|
|
+ :type '(repeat file)
|
|
|
+ :group 'org-contacts)
|
|
|
+
|
|
|
+(defcustom org-contacts-email-property "EMAIL"
|
|
|
+ "Name of the property for contact email address."
|
|
|
+ :type 'string
|
|
|
+ :group 'org-contacts)
|
|
|
+
|
|
|
+(defcustom org-contacts-birthday-property "BIRTHDAY"
|
|
|
+ "Name of the property for contact birthday date."
|
|
|
+ :type 'string
|
|
|
+ :group 'org-contacts)
|
|
|
+
|
|
|
+(defcustom org-contacts-last-read-mail-property "LAST_READ_MAIL"
|
|
|
+ "Name of the property for contact last read email link storage."
|
|
|
+ :type 'string
|
|
|
+ :group 'org-contacts)
|
|
|
+
|
|
|
+(defcustom org-contacts-icon-property "ICON"
|
|
|
+ "Name of the property for contact icon."
|
|
|
+ :type 'string
|
|
|
+ :group 'org-contacts)
|
|
|
+
|
|
|
+(defcustom org-contacts-nickname-property "NICKNAME"
|
|
|
+ "Name of the property for IRC nickname match."
|
|
|
+ :type 'string
|
|
|
+ :group 'org-contacts)
|
|
|
+
|
|
|
+(defcustom org-contacts-icon-size 32
|
|
|
+ "Size of the contacts icons."
|
|
|
+ :type 'string
|
|
|
+ :group 'org-contacts)
|
|
|
+
|
|
|
+(defcustom org-contacts-icon-use-gravatar (fboundp 'gravatar-retrieve)
|
|
|
+ "Whether use Gravatar to fetch contact icons."
|
|
|
+ :type 'boolean
|
|
|
+ :group 'org-contacts)
|
|
|
+
|
|
|
+(defcustom org-contacts-completion-ignore-case t
|
|
|
+ "Ignore case when completing contacts."
|
|
|
+ :type 'boolean
|
|
|
+ :group 'org-contacts)
|
|
|
+
|
|
|
+(defcustom org-contacts-group-prefix "+"
|
|
|
+ "Group prefix."
|
|
|
+ :type 'string
|
|
|
+ :group 'org-contacts)
|
|
|
+
|
|
|
+(defcustom org-contacts-matcher (concat org-contacts-email-property "<>\"\"")
|
|
|
+ "Matching rule for finding heading that are contacts.
|
|
|
+This can be a tag name, or a property check."
|
|
|
+ :type 'string
|
|
|
+ :group 'org-contacts)
|
|
|
+
|
|
|
+(defcustom org-contacts-email-link-description-format "%s (%d)"
|
|
|
+ "Format used to store links to email.
|
|
|
+This overrides `org-email-link-description-format' if set."
|
|
|
+ :group 'org-contacts
|
|
|
+ :type 'string)
|
|
|
+
|
|
|
+(defvar org-contacts-keymap
|
|
|
+ (let ((map (make-sparse-keymap)))
|
|
|
+ (define-key map "M" 'org-contacts-view-send-email)
|
|
|
+ (define-key map "i" 'org-contacts-view-switch-to-irc-buffer)
|
|
|
+ map)
|
|
|
+ "The keymap used in `org-contacts' result list.")
|
|
|
+
|
|
|
+(defun org-contacts-files ()
|
|
|
+ "Return list of Org files to use for contact management."
|
|
|
+ (or org-contacts-files (org-agenda-files t 'ifmode)))
|
|
|
+
|
|
|
+(defun org-contacts-filter (&optional name-match tags-match)
|
|
|
+ "Search for a contact maching NAME-MATCH and TAGS-MATCH.
|
|
|
+If both match values are nil, return all contacts."
|
|
|
+ (let ((tags-matcher
|
|
|
+ (if tags-match
|
|
|
+ (cdr (org-make-tags-matcher tags-match))
|
|
|
+ t))
|
|
|
+ (name-matcher
|
|
|
+ (if name-match
|
|
|
+ '(org-string-match-p name-match (org-get-heading t))
|
|
|
+ t))
|
|
|
+ (contacts-matcher
|
|
|
+ (cdr (org-make-tags-matcher org-contacts-matcher)))
|
|
|
+ markers result)
|
|
|
+ (dolist (file (org-contacts-files))
|
|
|
+ (org-check-agenda-file file)
|
|
|
+ (with-current-buffer (org-get-agenda-file-buffer file)
|
|
|
+ (unless (org-mode-p)
|
|
|
+ (error "File %s is no in `org-mode'" file))
|
|
|
+ (org-scan-tags
|
|
|
+ '(add-to-list 'markers (set-marker (make-marker) (point)))
|
|
|
+ `(and ,contacts-matcher ,tags-matcher ,name-matcher))))
|
|
|
+ (dolist (marker markers result)
|
|
|
+ (org-with-point-at marker
|
|
|
+ (add-to-list 'result
|
|
|
+ (list (org-get-heading t) marker (org-entry-properties marker 'all)))))))
|
|
|
+
|
|
|
+(when (not (fboundp 'completion-table-case-fold))
|
|
|
+ ;; That function is new in Emacs 24...
|
|
|
+ (defun completion-table-case-fold (table string pred action)
|
|
|
+ (let ((completion-ignore-case t))
|
|
|
+ (complete-with-action action table string pred))))
|
|
|
+
|
|
|
+(defun org-contacts-complete-name (&optional start)
|
|
|
+ "Complete text at START with a user name and email."
|
|
|
+ (let* ((end (point))
|
|
|
+ (start (or start
|
|
|
+ (save-excursion
|
|
|
+ (re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*")
|
|
|
+ (goto-char (match-end 0))
|
|
|
+ (point))))
|
|
|
+ (orig (buffer-substring start end))
|
|
|
+ (completion-ignore-case org-contacts-completion-ignore-case)
|
|
|
+ (group-completion-p (org-string-match-p (concat "^" org-contacts-group-prefix) orig))
|
|
|
+ (completion-list
|
|
|
+ (if group-completion-p
|
|
|
+ (mapcar (lambda (group) (propertize (concat org-contacts-group-prefix group) 'org-contacts-group group))
|
|
|
+ (org-uniquify
|
|
|
+ (loop for contact in (org-contacts-filter)
|
|
|
+ with group-list
|
|
|
+ nconc (org-split-string
|
|
|
+ (or (cdr (assoc-string "ALLTAGS" (caddr contact))) "") ":"))))
|
|
|
+ (loop for contact in (org-contacts-filter)
|
|
|
+ ;; The contact name is always the car of the assoc-list
|
|
|
+ ;; returned by `org-contacts-filter'.
|
|
|
+ for contact-name = (car contact)
|
|
|
+ ;; Build the list of the user email addresses.
|
|
|
+ for email-list = (split-string (or
|
|
|
+ (cdr (assoc-string org-contacts-email-property (caddr contact)))
|
|
|
+ ""))
|
|
|
+ ;; If the user has email addresses…
|
|
|
+ if email-list
|
|
|
+ ;; … append a list of USER <EMAIL>.
|
|
|
+ nconc (loop for email in email-list
|
|
|
+ collect (org-contacts-format-email contact-name email)))))
|
|
|
+ (completion-list (all-completions orig completion-list)))
|
|
|
+ ;; If we are completing a group, and that's the only group, just return
|
|
|
+ ;; the real result.
|
|
|
+ (when (and group-completion-p
|
|
|
+ (= (length completion-list) 1))
|
|
|
+ (setq completion-list
|
|
|
+ (list (concat (car completion-list) ";: "
|
|
|
+ (mapconcat 'identity
|
|
|
+ (loop for contact in (org-contacts-filter
|
|
|
+ nil
|
|
|
+ (get-text-property 0 'org-contacts-group (car completion-list)))
|
|
|
+ ;; The contact name is always the car of the assoc-list
|
|
|
+ ;; returned by `org-contacts-filter'.
|
|
|
+ for contact-name = (car contact)
|
|
|
+ ;; Grab the first email of the contact
|
|
|
+ for email = (car (split-string (or
|
|
|
+ (cdr (assoc-string org-contacts-email-property (caddr contact)))
|
|
|
+ "")))
|
|
|
+ ;; If the user has an email address, append USER <EMAIL>.
|
|
|
+ if email collect (org-contacts-format-email contact-name email))
|
|
|
+ ", ")))))
|
|
|
+ (list start end (if org-contacts-completion-ignore-case
|
|
|
+ (apply-partially #'completion-table-case-fold completion-list)
|
|
|
+ completion-list))))
|
|
|
+
|
|
|
+(defun org-contacts-message-complete-function ()
|
|
|
+ "Function used in `completion-at-point-functions' in `message-mode'."
|
|
|
+ (let ((mail-abbrev-mode-regexp
|
|
|
+ "^\\(Resent-To\\|To\\|B?Cc\\|Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\|Disposition-Notification-To\\|Return-Receipt-To\\):"))
|
|
|
+ (when (mail-abbrev-in-expansion-header-p)
|
|
|
+ (org-contacts-complete-name))))
|
|
|
+
|
|
|
+(add-hook 'message-mode-hook
|
|
|
+ (lambda ()
|
|
|
+ (add-to-list 'completion-at-point-functions
|
|
|
+ 'org-contacts-message-complete-function)))
|
|
|
+
|
|
|
+(defun org-contacts-gnus-get-name-email ()
|
|
|
+ "Get name and email address from Gnus message."
|
|
|
+ (gnus-with-article-headers
|
|
|
+ (mail-extract-address-components
|
|
|
+ (or (mail-fetch-field "From") ""))))
|
|
|
+
|
|
|
+(defun org-contacts-gnus-article-from-get-marker ()
|
|
|
+ "Return a marker for a contact based on From."
|
|
|
+ (let* ((address (org-contacts-gnus-get-name-email))
|
|
|
+ (name (car address))
|
|
|
+ (email (cadr address)))
|
|
|
+ (cadar (or (org-contacts-filter
|
|
|
+ nil
|
|
|
+ (concat org-contacts-email-property "={\\b" (regexp-quote email) "\\b}"))
|
|
|
+ (when name
|
|
|
+ (org-contacts-filter
|
|
|
+ (concat "^" name "$")))))))
|
|
|
+
|
|
|
+(defun org-contacts-gnus-article-from-goto ()
|
|
|
+ "Go to contact in the From address of current Gnus message."
|
|
|
+ (interactive)
|
|
|
+ (let ((marker (org-contacts-gnus-article-from-get-marker)))
|
|
|
+ (when marker
|
|
|
+ (switch-to-buffer-other-window (marker-buffer marker))
|
|
|
+ (goto-char marker)
|
|
|
+ (when (org-mode-p)
|
|
|
+ (org-show-context 'agenda)
|
|
|
+ (save-excursion
|
|
|
+ (and (outline-next-heading)
|
|
|
+ ;; show the next heading
|
|
|
+ (org-flag-heading nil)))))))
|
|
|
+
|
|
|
+(define-key gnus-summary-mode-map ";" 'org-contacts-gnus-article-from-goto)
|
|
|
+
|
|
|
+(defun org-contacts-anniversaries (&optional field format)
|
|
|
+ "Compute FIELD anniversary for each contact, returning FORMAT.
|
|
|
+Default FIELD value is \"BIRTHDAY\".
|
|
|
+
|
|
|
+Format is a string matching the following format specification:
|
|
|
+
|
|
|
+ %h - Heading name
|
|
|
+ %l - Link to the heading
|
|
|
+ %y - Number of year
|
|
|
+ %Y - Number of year (ordinal)"
|
|
|
+ (let ((calendar-date-style 'american)
|
|
|
+ (entry ""))
|
|
|
+ (loop for contact in (org-contacts-filter)
|
|
|
+ for anniv = (let ((anniv (cdr (assoc-string
|
|
|
+ (or field org-contacts-birthday-property)
|
|
|
+ (caddr contact)))))
|
|
|
+ (when anniv
|
|
|
+ (calendar-gregorian-from-absolute
|
|
|
+ (org-time-string-to-absolute anniv))))
|
|
|
+ ;; Use `diary-anniversary' to compute anniversary.
|
|
|
+ if (and anniv (apply 'diary-anniversary anniv))
|
|
|
+ collect (format-spec (or format "Birthday: %l (%Y)")
|
|
|
+ `((?l . ,(org-with-point-at (cadr contact) (org-store-link nil)))
|
|
|
+ (?h . ,(car contact))
|
|
|
+ (?y . ,(- (calendar-extract-year date)
|
|
|
+ (calendar-extract-year anniv)))
|
|
|
+ (?Y . ,(let ((years (- (calendar-extract-year date)
|
|
|
+ (calendar-extract-year anniv))))
|
|
|
+ (format "%d%s" years (diary-ordinal-suffix years)))))))))
|
|
|
+
|
|
|
+(defun org-completing-read-date (prompt collection
|
|
|
+ &optional predicate require-match initial-input
|
|
|
+ hist def inherit-input-method)
|
|
|
+ "Like `completing-read' but reads a date.
|
|
|
+Only PROMPT and DEF are really used."
|
|
|
+ (org-read-date nil nil nil prompt nil def))
|
|
|
+
|
|
|
+(add-to-list 'org-property-set-functions-alist
|
|
|
+ `(,org-contacts-birthday-property . org-completing-read-date))
|
|
|
+
|
|
|
+(defun org-contacts-template-name (&optional return-value)
|
|
|
+ "Try to return the contact name for a template.
|
|
|
+If not found return RETURN-VALUE or something that would ask the user."
|
|
|
+ (or (car (org-contacts-gnus-get-name-email))
|
|
|
+ return-value
|
|
|
+ "%^{Name}"))
|
|
|
+
|
|
|
+(defun org-contacts-template-email (&optional return-value)
|
|
|
+ "Try to return the contact email for a template.
|
|
|
+If not found return RETURN-VALUE or something that would ask the user."
|
|
|
+ (or (cadr (org-contacts-gnus-get-name-email))
|
|
|
+ return-value
|
|
|
+ (concat "%^{" org-contacts-email-property "}p")))
|
|
|
+
|
|
|
+(defun org-contacts-gnus-store-last-mail ()
|
|
|
+ "Store a link between mails and contacts.
|
|
|
+
|
|
|
+This function should be called from `gnus-article-prepare-hook'."
|
|
|
+ (let ((marker (org-contacts-gnus-article-from-get-marker)))
|
|
|
+ (when marker
|
|
|
+ (with-current-buffer (marker-buffer marker)
|
|
|
+ (save-excursion
|
|
|
+ (goto-char marker)
|
|
|
+ (let* ((org-email-link-description-format (or org-contacts-email-link-description-format
|
|
|
+ org-email-link-description-format))
|
|
|
+ (link (gnus-with-article-buffer (org-store-link nil))))
|
|
|
+ (org-set-property org-contacts-last-read-mail-property link)))))))
|
|
|
+
|
|
|
+(add-hook 'gnus-article-prepare-hook 'org-contacts-gnus-store-last-mail)
|
|
|
+
|
|
|
+(defun org-contacts-icon-as-string ()
|
|
|
+ (let ((image (org-contacts-get-icon)))
|
|
|
+ (concat
|
|
|
+ (propertize "-" 'display
|
|
|
+ (append
|
|
|
+ (if image
|
|
|
+ image
|
|
|
+ `'(space :width (,org-contacts-icon-size)))
|
|
|
+ '(:ascent center)))
|
|
|
+ " ")))
|
|
|
+
|
|
|
+;;;###autoload
|
|
|
+(defun org-contacts (name)
|
|
|
+ "Create agenda view for contacts matching NAME."
|
|
|
+ (interactive (list (read-string "Name: ")))
|
|
|
+ (let ((org-agenda-files (org-contacts-files))
|
|
|
+ (org-agenda-skip-function
|
|
|
+ (lambda () (org-agenda-skip-if nil `(notregexp ,name))))
|
|
|
+ (org-agenda-format (propertize
|
|
|
+ "%(org-contacts-icon-as-string)% p% s%(org-contacts-irc-number-of-unread-messages)%+T"
|
|
|
+ 'keymap org-contacts-keymap))
|
|
|
+ (org-agenda-overriding-header
|
|
|
+ (or org-agenda-overriding-header
|
|
|
+ (concat "List of contacts matching `" name "':"))))
|
|
|
+ (setq org-agenda-skip-regexp name)
|
|
|
+ (org-tags-view nil org-contacts-matcher)
|
|
|
+ (with-current-buffer org-agenda-buffer-name
|
|
|
+ (setq org-agenda-redo-command
|
|
|
+ (list 'org-contacts name)))))
|
|
|
+
|
|
|
+(defun org-contacts-completing-read (prompt
|
|
|
+ &optional predicate
|
|
|
+ initial-input hist def inherit-input-method)
|
|
|
+ "Call `completing-read' with contacts name as collection."
|
|
|
+ (org-completing-read
|
|
|
+ prompt (org-contacts-filter) predicate t initial-input hist def inherit-input-method))
|
|
|
+
|
|
|
+(defun org-contacts-format-email (name email)
|
|
|
+ "Format a mail address."
|
|
|
+ (unless email
|
|
|
+ (error "`email' cannot be nul"))
|
|
|
+ (if name
|
|
|
+ (concat name " <" email ">")
|
|
|
+ email))
|
|
|
+
|
|
|
+(defun org-contacts-check-mail-address (mail)
|
|
|
+ "Add MAIL address to contact at point if it does not have it."
|
|
|
+ (let ((mails (org-entry-get (point) org-contacts-email-property)))
|
|
|
+ (unless (member mail (split-string mails))
|
|
|
+ (when (yes-or-no-p
|
|
|
+ (format "Do you want to this address to %s?" (org-get-heading t)))
|
|
|
+ (org-set-property org-contacts-email-property (concat mails " " mail))))))
|
|
|
+
|
|
|
+(defun org-contacts-gnus-check-mail-address ()
|
|
|
+ "Check that contact has the current address recorded.
|
|
|
+This function should be called from `gnus-article-prepare-hook'."
|
|
|
+ (let ((marker (org-contacts-gnus-article-from-get-marker)))
|
|
|
+ (when marker
|
|
|
+ (org-with-point-at marker
|
|
|
+ (org-contacts-check-mail-address (cadr (org-contacts-gnus-get-name-email)))))))
|
|
|
+
|
|
|
+(add-hook 'gnus-article-prepare-hook 'org-contacts-gnus-check-mail-address)
|
|
|
+
|
|
|
+(defun org-contacts-view-send-email (&optional ask)
|
|
|
+ "Send email to the contact at point.
|
|
|
+If ASK is set, ask for the email address even if there's only one address."
|
|
|
+ (interactive "P")
|
|
|
+ (let ((marker (org-get-at-bol 'org-hd-marker)))
|
|
|
+ (org-with-point-at marker
|
|
|
+ (let ((emails (org-entry-get (point) org-contacts-email-property)))
|
|
|
+ (if emails
|
|
|
+ (let ((email-list (split-string emails)))
|
|
|
+ (if (and (= (length email-list) 1) (not ask))
|
|
|
+ (compose-mail (org-contacts-format-email
|
|
|
+ (org-get-heading t) emails))
|
|
|
+ (let ((email (completing-read "Send mail to which address: " email-list)))
|
|
|
+ (org-contacts-check-mail-address email)
|
|
|
+ (compose-mail (org-contacts-format-email (org-get-heading t) email)))))
|
|
|
+ (error (format "This contact has no mail address set (no %s property)."
|
|
|
+ org-contacts-email-property)))))))
|
|
|
+
|
|
|
+(defun org-contacts-get-icon (&optional pom)
|
|
|
+ "Get icon for contact at POM."
|
|
|
+ (setq pom (or pom (point)))
|
|
|
+ (catch 'icon
|
|
|
+ ;; Use `org-contacts-icon-property'
|
|
|
+ (let ((image-data (org-entry-get pom org-contacts-icon-property)))
|
|
|
+ (when image-data
|
|
|
+ (throw 'icon
|
|
|
+ (if (fboundp 'gnus-rescale-image)
|
|
|
+ (gnus-rescale-image (create-image image-data)
|
|
|
+ (cons org-contacts-icon-size org-contacts-icon-size))
|
|
|
+ (create-image image-data)))))
|
|
|
+ ;; Next, try Gravatar
|
|
|
+ (when org-contacts-icon-use-gravatar
|
|
|
+ (let* ((gravatar-size org-contacts-icon-size)
|
|
|
+ (email-list (org-entry-get pom org-contacts-email-property))
|
|
|
+ (gravatar
|
|
|
+ (when email-list
|
|
|
+ (loop for email in (split-string email-list)
|
|
|
+ for gravatar = (gravatar-retrieve-synchronously email)
|
|
|
+ if (and gravatar
|
|
|
+ (not (eq gravatar 'error)))
|
|
|
+ return gravatar))))
|
|
|
+ (when gravatar (throw 'icon gravatar))))))
|
|
|
+
|
|
|
+(defun org-contacts-irc-buffer (&optional pom)
|
|
|
+ "Get the IRC buffer associated with the entry at POM."
|
|
|
+ (setq pom (or pom (point)))
|
|
|
+ (let ((nick (org-entry-get pom org-contacts-nickname-property)))
|
|
|
+ (when nick
|
|
|
+ (let ((buffer (get-buffer nick)))
|
|
|
+ (when buffer
|
|
|
+ (with-current-buffer buffer
|
|
|
+ (when (eq major-mode 'erc-mode)
|
|
|
+ buffer)))))))
|
|
|
+
|
|
|
+(defun org-contacts-irc-number-of-unread-messages (&optional pom)
|
|
|
+ "Return the number of unread messages for contact at POM."
|
|
|
+ (when (boundp 'erc-modified-channels-alist)
|
|
|
+ (let ((number (cadr (assoc (org-contacts-irc-buffer pom) erc-modified-channels-alist))))
|
|
|
+ (if number
|
|
|
+ (format (concat "%3d unread message" (if (> number 1) "s" " ") " ") number)
|
|
|
+ (make-string 21 ? )))))
|
|
|
+
|
|
|
+(defun org-contacts-view-switch-to-irc-buffer ()
|
|
|
+ "Switch to the IRC buffer of the current contact if it has one."
|
|
|
+ (interactive)
|
|
|
+ (let ((marker (org-get-at-bol 'org-hd-marker)))
|
|
|
+ (org-with-point-at marker
|
|
|
+ (switch-to-buffer-other-window (org-contacts-irc-buffer)))))
|
|
|
+
|
|
|
+(defun org-contacts-completing-read-nickname (prompt collection
|
|
|
+ &optional predicate require-match initial-input
|
|
|
+ hist def inherit-input-method)
|
|
|
+ "Like `completing-read' but reads a nickname."
|
|
|
+ (org-completing-read prompt (append collection (erc-nicknames-list)) predicate require-match
|
|
|
+ initial-input hist def inherit-input-method))
|
|
|
+
|
|
|
+(defun erc-nicknames-list ()
|
|
|
+ "Return all nicknames of all ERC buffers."
|
|
|
+ (loop for buffer in (erc-buffer-list)
|
|
|
+ nconc (with-current-buffer buffer
|
|
|
+ (loop for user-entry in (mapcar 'car (erc-get-channel-user-list))
|
|
|
+ collect (elt user-entry 1)))))
|
|
|
+
|
|
|
+(add-to-list 'org-property-set-functions-alist
|
|
|
+ `(,org-contacts-nickname-property . org-contacts-completing-read-nickname))
|
|
|
+
|
|
|
+(provide 'org-contacts)
|
Julien Danjou