Restructure emacs configuration
This commit is contained in:
parent
0b0f0fa73c
commit
9a50086107
17 changed files with 1167 additions and 803 deletions
16
.emacs.d/.gitignore
vendored
16
.emacs.d/.gitignore
vendored
|
|
@ -1,16 +0,0 @@
|
||||||
tramp
|
|
||||||
elpa
|
|
||||||
bookmarks
|
|
||||||
abbrev_defs
|
|
||||||
custom.el
|
|
||||||
*.elc
|
|
||||||
ac-comphist.dat
|
|
||||||
auto-save-list/
|
|
||||||
url/
|
|
||||||
packages/
|
|
||||||
newsticker/
|
|
||||||
templates/
|
|
||||||
themes/
|
|
||||||
rinit.*
|
|
||||||
!rinit.org
|
|
||||||
history
|
|
||||||
9
.emacs.d/.gitmodules
vendored
9
.emacs.d/.gitmodules
vendored
|
|
@ -1,9 +0,0 @@
|
||||||
[submodule "site-lisp/identica-mode"]
|
|
||||||
path = site-lisp/identica-mode
|
|
||||||
url = git://git.sv.gnu.org/identica-mode.git
|
|
||||||
[submodule "site-lisp/tron-theme"]
|
|
||||||
path = site-lisp/tron-theme
|
|
||||||
url = git://gitorious.org/ryuslash/tron-theme.git
|
|
||||||
[submodule "site-lisp/git-auto-commit-mode"]
|
|
||||||
path = site-lisp/git-auto-commit-mode
|
|
||||||
url = git://gitorious.org/git-auto-commit-mode/git-auto-commit-mode.git
|
|
||||||
4
.emacs.d/eshell/.gitignore
vendored
4
.emacs.d/eshell/.gitignore
vendored
|
|
@ -1,4 +0,0 @@
|
||||||
*
|
|
||||||
!.gitignore
|
|
||||||
!login
|
|
||||||
!alias
|
|
||||||
|
|
@ -1,2 +0,0 @@
|
||||||
(defun inspect (var)
|
|
||||||
(symbol-value (intern var)))
|
|
||||||
|
|
@ -1,13 +0,0 @@
|
||||||
;; -*- mode: Emacs-Lisp; eval: (git-auto-commit-mode 1) -*-
|
|
||||||
(require 'bytecomp)
|
|
||||||
|
|
||||||
(defvar startup-files
|
|
||||||
(directory-files "~/.emacs.d/startup/" t "^[^.].*\\.el$")
|
|
||||||
"A list of the files that should be loaded during startup.")
|
|
||||||
|
|
||||||
(while startup-files
|
|
||||||
(let ((filename (car startup-files))
|
|
||||||
(byte-compile-warnings nil))
|
|
||||||
(if (not (eq (byte-recompile-file filename nil 0) nil))
|
|
||||||
(load (substring filename 0 -3))))
|
|
||||||
(setq startup-files (cdr startup-files)))
|
|
||||||
1
.emacs.d/site-lisp/.gitignore
vendored
1
.emacs.d/site-lisp/.gitignore
vendored
|
|
@ -1 +0,0 @@
|
||||||
rudel/
|
|
||||||
|
|
@ -1,95 +0,0 @@
|
||||||
;;; autosmiley.el --- Convert smileys into their graphical representation
|
|
||||||
|
|
||||||
;; Author: Damyan Pepper (gmail account, username damyanp)
|
|
||||||
;; Created: 20060315
|
|
||||||
|
|
||||||
;; This program 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 2, or (at
|
|
||||||
;; your option) any later version.
|
|
||||||
|
|
||||||
;; This program 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 this program; if not, you can either send email to this
|
|
||||||
;; program's maintainer or write to: The Free Software Foundation,
|
|
||||||
;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
|
|
||||||
|
|
||||||
;;; Commentary:
|
|
||||||
|
|
||||||
;; Defines the minor mode autosmiley-mode that converts smileys like
|
|
||||||
;; :-) into their graphical representations on the fly.
|
|
||||||
|
|
||||||
;; Tested on:
|
|
||||||
;;
|
|
||||||
;; GNU Emacs 22.0.50.1 (i386-mingw-nt5.1.2600) of 2006-03-14 on W2ONE
|
|
||||||
;;
|
|
||||||
;; History:
|
|
||||||
;;
|
|
||||||
;; 20060315 - First Release
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(require 'smiley)
|
|
||||||
|
|
||||||
(defun autosmiley-overlay-p (overlay)
|
|
||||||
"Return whether OVERLAY is an overlay of autosmiley mode."
|
|
||||||
(memq (overlay-get overlay 'category)
|
|
||||||
'(autosmiley)))
|
|
||||||
|
|
||||||
(defun autosmiley-remove-smileys (beg end)
|
|
||||||
(dolist (o (overlays-in beg end))
|
|
||||||
(when (autosmiley-overlay-p o)
|
|
||||||
(delete-overlay o))))
|
|
||||||
|
|
||||||
(defvar *autosmiley-counter* 0
|
|
||||||
"Each smiley needs to have a unique display string otherwise
|
|
||||||
adjacent smileys will be merged into a single image. So we put
|
|
||||||
a counter on each one to make them unique")
|
|
||||||
|
|
||||||
(defun autosmiley-add-smiley (beg end image)
|
|
||||||
(let ((overlay (make-overlay beg end)))
|
|
||||||
(overlay-put overlay 'category 'autosmiley)
|
|
||||||
(overlay-put overlay 'display (append image (list :counter (incf *autosmiley-counter*))))))
|
|
||||||
|
|
||||||
|
|
||||||
(defun autosmiley-add-smileys (beg end)
|
|
||||||
(save-excursion
|
|
||||||
(dolist (entry smiley-cached-regexp-alist)
|
|
||||||
(let ((regexp (car entry))
|
|
||||||
(group (nth 1 entry))
|
|
||||||
(image (nth 2 entry)))
|
|
||||||
(when image
|
|
||||||
(goto-char beg)
|
|
||||||
(while (re-search-forward regexp end t)
|
|
||||||
(autosmiley-add-smiley (match-beginning group) (match-end group) image)))))))
|
|
||||||
|
|
||||||
|
|
||||||
(defun autosmiley-change (beg end &optional old-len)
|
|
||||||
(let ((beg-line (save-excursion (goto-char beg) (line-beginning-position)))
|
|
||||||
(end-line (save-excursion (goto-char end) (line-end-position))))
|
|
||||||
(autosmiley-remove-smileys beg-line end-line)
|
|
||||||
(autosmiley-add-smileys beg-line end-line)))
|
|
||||||
|
|
||||||
|
|
||||||
;;;###autoload
|
|
||||||
(define-minor-mode autosmiley-mode
|
|
||||||
"Minor mode for automatically replacing smileys in text with
|
|
||||||
cute little graphical smileys."
|
|
||||||
:group 'autosmiley :lighter " :)"
|
|
||||||
(save-excursion
|
|
||||||
(save-restriction
|
|
||||||
(widen)
|
|
||||||
(autosmiley-remove-smileys (point-min) (point-max))
|
|
||||||
(if autosmiley-mode
|
|
||||||
(progn
|
|
||||||
(unless smiley-cached-regexp-alist
|
|
||||||
(smiley-update-cache))
|
|
||||||
(jit-lock-register 'autosmiley-change))
|
|
||||||
(jit-lock-unregister 'autosmiley-change)))))
|
|
||||||
|
|
||||||
|
|
||||||
(provide 'autosmiley)
|
|
||||||
|
|
@ -1,620 +0,0 @@
|
||||||
;;; org-contacts.el --- Contacts management
|
|
||||||
|
|
||||||
;; Copyright (C) 2010-2012 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-when-compile
|
|
||||||
(require 'cl))
|
|
||||||
|
|
||||||
(eval-and-compile
|
|
||||||
(require 'org))
|
|
||||||
|
|
||||||
(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-address-property "ADDRESS"
|
|
||||||
"Name of the property for contact 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-birthday-format "Birthday: %l (%Y)"
|
|
||||||
"Format of the anniversary agenda entry. The following replacements are available:
|
|
||||||
|
|
||||||
%h - Heading name
|
|
||||||
%l - Link to the heading
|
|
||||||
%y - Number of year
|
|
||||||
%Y - Number of year (ordinal)"
|
|
||||||
: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)
|
|
||||||
|
|
||||||
(defcustom org-contacts-vcard-file "contacts.vcf"
|
|
||||||
"Default file for vcard export."
|
|
||||||
:group 'org-contacts
|
|
||||||
:type 'file)
|
|
||||||
|
|
||||||
(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* (todo-only
|
|
||||||
(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 (eq major-mode 'org-mode)
|
|
||||||
(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)
|
|
||||||
todo-only)))
|
|
||||||
(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 &optional dont-fold)
|
|
||||||
(lambda (string pred action)
|
|
||||||
(let ((completion-ignore-case (not dont-fold)))
|
|
||||||
(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 (completion-table-case-fold completion-list (not org-contacts-completion-ignore-case)))))
|
|
||||||
|
|
||||||
(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))))
|
|
||||||
|
|
||||||
(defun org-contacts-gnus-get-name-email ()
|
|
||||||
"Get name and email address from Gnus message."
|
|
||||||
(if (gnus-alive-p)
|
|
||||||
(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 (eq major-mode 'org-mode)
|
|
||||||
(org-show-context 'agenda)
|
|
||||||
(save-excursion
|
|
||||||
(and (outline-next-heading)
|
|
||||||
;; show the next heading
|
|
||||||
(org-flag-heading nil)))))))
|
|
||||||
|
|
||||||
(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 ""))
|
|
||||||
(unless format (setq format org-contacts-birthday-format))
|
|
||||||
(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 format
|
|
||||||
`((?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)))))))
|
|
||||||
|
|
||||||
(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 add 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)))))))
|
|
||||||
|
|
||||||
(defun org-contacts-gnus-insinuate ()
|
|
||||||
"Add some hooks for Gnus user.
|
|
||||||
This adds `org-contacts-gnus-check-mail-address' and
|
|
||||||
`org-contacts-gnus-store-last-mail' to
|
|
||||||
`gnus-article-prepare-hook'. It also adds a binding on `;' in
|
|
||||||
`gnus-summary-mode-map' to `org-contacts-gnus-article-from-goto'"
|
|
||||||
(require 'gnus)
|
|
||||||
(require 'gnus-art)
|
|
||||||
(define-key gnus-summary-mode-map ";" 'org-contacts-gnus-article-from-goto)
|
|
||||||
(add-hook 'gnus-article-prepare-hook 'org-contacts-gnus-check-mail-address)
|
|
||||||
(add-hook 'gnus-article-prepare-hook 'org-contacts-gnus-store-last-mail))
|
|
||||||
|
|
||||||
(when (boundp 'completion-at-point-functions)
|
|
||||||
(add-hook 'message-mode-hook
|
|
||||||
(lambda ()
|
|
||||||
(add-to-list 'completion-at-point-functions
|
|
||||||
'org-contacts-message-complete-function))))
|
|
||||||
|
|
||||||
(defun org-contacts-wl-get-from-header-content ()
|
|
||||||
"Retrieve the content of the `From' header of an email.
|
|
||||||
Works from wl-summary-mode and mime-view-mode - that is while viewing email.
|
|
||||||
Depends on Wanderlust been loaded."
|
|
||||||
(with-current-buffer (org-capture-get :original-buffer)
|
|
||||||
(cond
|
|
||||||
((eq major-mode 'wl-summary-mode) (when wl-summary-buffer-elmo-folder
|
|
||||||
(elmo-message-field
|
|
||||||
wl-summary-buffer-elmo-folder
|
|
||||||
(wl-summary-message-number)
|
|
||||||
'from)))
|
|
||||||
((eq major-mode 'mime-view-mode) (std11-narrow-to-header)
|
|
||||||
(prog1
|
|
||||||
(std11-fetch-field "From")
|
|
||||||
(widen))))))
|
|
||||||
|
|
||||||
(defun org-contacts-wl-get-name-email ()
|
|
||||||
"Get name and email address from wanderlust email.
|
|
||||||
See `org-contacts-wl-get-from-header-content' for limitations."
|
|
||||||
(let ((from (org-contacts-wl-get-from-header-content)))
|
|
||||||
(when from
|
|
||||||
(list (wl-address-header-extract-realname from)
|
|
||||||
(wl-address-header-extract-address from)))))
|
|
||||||
|
|
||||||
(defun org-contacts-template-wl-name (&optional return-value)
|
|
||||||
"Try to return the contact name for a template from wl.
|
|
||||||
If not found return RETURN-VALUE or something that would ask the user."
|
|
||||||
(or (car (org-contacts-wl-get-name-email))
|
|
||||||
return-value
|
|
||||||
"%^{Name}"))
|
|
||||||
|
|
||||||
(defun org-contacts-template-wl-email (&optional return-value)
|
|
||||||
"Try to return the contact email for a template from wl.
|
|
||||||
If not found return RETURN-VALUE or something that would ask the user."
|
|
||||||
(or (cadr (org-contacts-wl-get-name-email))
|
|
||||||
return-value
|
|
||||||
(concat "%^{" org-contacts-email-property "}p")))
|
|
||||||
|
|
||||||
(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."
|
|
||||||
(if (fboundp 'erc-buffer-list)
|
|
||||||
(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))
|
|
||||||
|
|
||||||
(defun org-contacts-vcard-escape (str)
|
|
||||||
"Escape ; , and \n in STR for use in the VCard format.
|
|
||||||
Thanks to http://www.emacswiki.org/cgi-bin/wiki/bbdb-vcard-export.el for the regexp."
|
|
||||||
(when str
|
|
||||||
(replace-regexp-in-string "\n" "\\\\n" (replace-regexp-in-string "\\(;\\|,\\|\\\\\\)" "\\\\\\1" str))))
|
|
||||||
|
|
||||||
(defun org-contacts-vcard-encode-name (name)
|
|
||||||
"Try to encode NAME as VCard's N property. The N property expects FamilyName;GivenName;AdditionalNames;Prefix;Postfix.
|
|
||||||
Org-contacts does not specify how to encode the name. So we try to do our best."
|
|
||||||
(concat (replace-regexp-in-string "\\(\\w+\\) \\(.*\\)" "\\2;\\1" name) ";;;"))
|
|
||||||
|
|
||||||
(defun org-contacts-vcard-format (contact)
|
|
||||||
"Formats CONTACT in VCard 3.0 format."
|
|
||||||
(let* ((properties (caddr contact))
|
|
||||||
(name (org-contacts-vcard-escape (car contact)))
|
|
||||||
(n (org-contacts-vcard-encode-name name))
|
|
||||||
(email (org-contacts-vcard-escape (cdr (assoc-string org-contacts-email-property properties))))
|
|
||||||
(bday (org-contacts-vcard-escape (cdr (assoc-string org-contacts-birthday-property properties))))
|
|
||||||
(addr (cdr (assoc-string org-contacts-address-property properties)))
|
|
||||||
(nick (org-contacts-vcard-escape (cdr (assoc-string org-contacts-nickname-property properties))))
|
|
||||||
|
|
||||||
(head (format "BEGIN:VCARD\nVERSION:3.0\nN:%s\nFN:%s\n" n name)))
|
|
||||||
(concat head
|
|
||||||
(when email (format "EMAIL:%s\n" email))
|
|
||||||
(when addr
|
|
||||||
(format "ADR:;;%s\n" (replace-regexp-in-string "\\, ?" ";" addr)))
|
|
||||||
(when bday
|
|
||||||
(let ((cal-bday (calendar-gregorian-from-absolute (org-time-string-to-absolute bday))))
|
|
||||||
(format "BDAY:%04d-%02d-%02d\n"
|
|
||||||
(calendar-extract-year cal-bday)
|
|
||||||
(calendar-extract-month cal-bday)
|
|
||||||
(calendar-extract-day cal-bday))))
|
|
||||||
(when nick (format "NICKNAME:%s\n" nick))
|
|
||||||
"END:VCARD\n\n")))
|
|
||||||
|
|
||||||
(defun org-contacts-export-as-vcard (&optional name file to-buffer)
|
|
||||||
"Export all contacts matching NAME as VCard 3.0. It TO-BUFFER is nil, the content is written to FILE or `org-contacts-vcard-file'. If TO-BUFFER is non-nil, the buffer is created and the VCard is written into that buffer."
|
|
||||||
(interactive) ; TODO ask for name?
|
|
||||||
(let* ((filename (or file org-contacts-vcard-file))
|
|
||||||
(buffer (if to-buffer
|
|
||||||
(get-buffer-create to-buffer)
|
|
||||||
(find-file-noselect filename))))
|
|
||||||
|
|
||||||
(message "Exporting...")
|
|
||||||
|
|
||||||
(set-buffer buffer)
|
|
||||||
(let ((inhibit-read-only t)) (erase-buffer))
|
|
||||||
(fundamental-mode)
|
|
||||||
(org-install-letbind)
|
|
||||||
|
|
||||||
(when (fboundp 'set-buffer-file-coding-system)
|
|
||||||
(set-buffer-file-coding-system coding-system-for-write))
|
|
||||||
|
|
||||||
(loop for contact in (org-contacts-filter name)
|
|
||||||
do (insert (org-contacts-vcard-format contact)))
|
|
||||||
|
|
||||||
(if to-buffer
|
|
||||||
(current-buffer)
|
|
||||||
(progn (save-buffer) (kill-buffer)))))
|
|
||||||
|
|
||||||
(defun org-contacts-show-map (&optional name)
|
|
||||||
"Show contacts on a map. Requires google-maps-el."
|
|
||||||
(interactive)
|
|
||||||
(unless (fboundp 'google-maps-static-show)
|
|
||||||
(error "org-contacts-show-map requires google-maps-el."))
|
|
||||||
(google-maps-static-show
|
|
||||||
:markers
|
|
||||||
(loop
|
|
||||||
for contact in (org-contacts-filter name)
|
|
||||||
for addr = (cdr (assoc-string org-contacts-address-property (caddr contact)))
|
|
||||||
if addr
|
|
||||||
collect (cons (list addr) (list :label (string-to-char (car contact)))))))
|
|
||||||
|
|
||||||
(provide 'org-contacts)
|
|
||||||
|
|
@ -1,33 +0,0 @@
|
||||||
(require 'simple)
|
|
||||||
|
|
||||||
(defun indent-shift-left (start end &optional count)
|
|
||||||
(interactive
|
|
||||||
(if mark-active
|
|
||||||
(list (region-beginning) (region-end) current-prefix-arg)
|
|
||||||
(list (line-beginning-position) (line-end-position) current-prefix-arg)))
|
|
||||||
(if count
|
|
||||||
(setq count (prefix-numeric-value count))
|
|
||||||
(setq count tab-width))
|
|
||||||
(when (> count 0)
|
|
||||||
(let ((deactivate-mark nil))
|
|
||||||
(save-excursion
|
|
||||||
(goto-char start)
|
|
||||||
(while (< (point) end)
|
|
||||||
(if (and (< (current-indentation) count)
|
|
||||||
(not (looking-at "[ \t]*$")))
|
|
||||||
(error "Can't shift all lines enough"))
|
|
||||||
(forward-line))
|
|
||||||
(indent-rigidly start end (- count))))))
|
|
||||||
|
|
||||||
(add-to-list 'debug-ignored-errors "^Can't shift all lines enough")
|
|
||||||
|
|
||||||
(defun indent-shift-right (start end &optional count)
|
|
||||||
(interactive
|
|
||||||
(if mark-active
|
|
||||||
(list (region-beginning) (region-end) current-prefix-arg)
|
|
||||||
(list (line-beginning-position) (line-end-position) current-prefix-arg)))
|
|
||||||
(let ((deactivate-mark nil))
|
|
||||||
(if count
|
|
||||||
(setq count (prefix-numeric-value count))
|
|
||||||
(setq count tab-width))
|
|
||||||
(indent-rigidly start end count)))
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
(define-generic-mode 'xmodmap-mode
|
|
||||||
'(?!)
|
|
||||||
'("add" "clear" "keycode" "keysym" "pointer" "remove")
|
|
||||||
nil
|
|
||||||
'("[xX]modmap\\(rc\\)?\\'")
|
|
||||||
nil
|
|
||||||
"Simple mode for xmodmap files.")
|
|
||||||
|
|
||||||
(provide 'xmodmap-mode)
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
((nil . ((eval . (git-auto-commit-mode)))))
|
|
||||||
13
Makefile
Normal file
13
Makefile
Normal file
|
|
@ -0,0 +1,13 @@
|
||||||
|
modules = emacs
|
||||||
|
install-modules = $(addprefix install-,$(modules))
|
||||||
|
|
||||||
|
.PHONY: all install $(modules) $(install-modules)
|
||||||
|
|
||||||
|
all: $(modules)
|
||||||
|
install: $(install-modules)
|
||||||
|
|
||||||
|
$(modules):
|
||||||
|
$(MAKE) -C $@/
|
||||||
|
|
||||||
|
$(install-modules): install-%:
|
||||||
|
$(MAKE) -C $*/ install
|
||||||
24
emacs/Makefile
Normal file
24
emacs/Makefile
Normal file
|
|
@ -0,0 +1,24 @@
|
||||||
|
EMACS = emacs
|
||||||
|
|
||||||
|
files = init.el init.elc
|
||||||
|
install-files = $(addprefix install-,$(files))
|
||||||
|
submodules = eshell
|
||||||
|
install-submodules = $(addprefix install-,$(submodules))
|
||||||
|
|
||||||
|
.PHONY: all $(submodules) install $(install-submodules) $(install-files)
|
||||||
|
|
||||||
|
all: $(files) $(submodules)
|
||||||
|
|
||||||
|
$(submodules):
|
||||||
|
$(MAKE) -C $@/
|
||||||
|
|
||||||
|
$(filter %.elc,$(files)): %.elc: %.el
|
||||||
|
$(EMACS) -batch -eval "(byte-compile-file \"$^\")"
|
||||||
|
|
||||||
|
install: $(install-files) $(install-submodules)
|
||||||
|
|
||||||
|
$(install-files): install-%:
|
||||||
|
install -Dm 444 $* ${HOME}/.emacs.d/$*
|
||||||
|
|
||||||
|
$(install-submodules): install-%:
|
||||||
|
$(MAKE) -C $*/ install
|
||||||
6
emacs/eshell/Makefile
Normal file
6
emacs/eshell/Makefile
Normal file
|
|
@ -0,0 +1,6 @@
|
||||||
|
.PHONY: all install
|
||||||
|
|
||||||
|
all:
|
||||||
|
|
||||||
|
install:
|
||||||
|
install -Dm 444 alias ${HOME}/.emacs.d/eshell/alias
|
||||||
1124
emacs/init.el
Normal file
1124
emacs/init.el
Normal file
File diff suppressed because it is too large
Load diff
Loading…
Reference in a new issue