From 9a500861070e1ce374064d14ee2372e12c22a06f Mon Sep 17 00:00:00 2001 From: Tom Willemsen Date: Sat, 18 Aug 2012 13:57:56 +0200 Subject: Restructure emacs configuration --- .emacs.d/site-lisp/.gitignore | 1 - .emacs.d/site-lisp/autosmiley.el | 95 ------ .emacs.d/site-lisp/org-contacts.el | 620 ------------------------------------- .emacs.d/site-lisp/shift-indent.el | 33 -- .emacs.d/site-lisp/xmodmap-mode.el | 9 - 5 files changed, 758 deletions(-) delete mode 100644 .emacs.d/site-lisp/.gitignore delete mode 100644 .emacs.d/site-lisp/autosmiley.el delete mode 100644 .emacs.d/site-lisp/org-contacts.el delete mode 100644 .emacs.d/site-lisp/shift-indent.el delete mode 100644 .emacs.d/site-lisp/xmodmap-mode.el (limited to '.emacs.d/site-lisp') diff --git a/.emacs.d/site-lisp/.gitignore b/.emacs.d/site-lisp/.gitignore deleted file mode 100644 index 813048b..0000000 --- a/.emacs.d/site-lisp/.gitignore +++ /dev/null @@ -1 +0,0 @@ -rudel/ diff --git a/.emacs.d/site-lisp/autosmiley.el b/.emacs.d/site-lisp/autosmiley.el deleted file mode 100644 index 1037e43..0000000 --- a/.emacs.d/site-lisp/autosmiley.el +++ /dev/null @@ -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) diff --git a/.emacs.d/site-lisp/org-contacts.el b/.emacs.d/site-lisp/org-contacts.el deleted file mode 100644 index b6d9e50..0000000 --- a/.emacs.d/site-lisp/org-contacts.el +++ /dev/null @@ -1,620 +0,0 @@ -;;; org-contacts.el --- Contacts management - -;; Copyright (C) 2010-2012 Julien Danjou - -;; Author: Julien Danjou -;; 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 . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; 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 . - 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 . - 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) diff --git a/.emacs.d/site-lisp/shift-indent.el b/.emacs.d/site-lisp/shift-indent.el deleted file mode 100644 index d6d6e76..0000000 --- a/.emacs.d/site-lisp/shift-indent.el +++ /dev/null @@ -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))) diff --git a/.emacs.d/site-lisp/xmodmap-mode.el b/.emacs.d/site-lisp/xmodmap-mode.el deleted file mode 100644 index 3002a49..0000000 --- a/.emacs.d/site-lisp/xmodmap-mode.el +++ /dev/null @@ -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) -- cgit v1.2.3-54-g00ecf