summaryrefslogtreecommitdiff
path: root/.emacs.d/org-7.4/contrib/lisp
diff options
context:
space:
mode:
Diffstat (limited to '.emacs.d/org-7.4/contrib/lisp')
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/.DS_Storebin6148 -> 0 bytes
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/htmlize.el1769
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-annotate-file.el130
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-bookmark.el88
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-checklist.el143
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-choose.el539
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-collector.el235
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-contribdir.el38
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-depend.el279
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-drill.el1144
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-elisp-symbol.el159
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-eval-light.el200
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-eval.el220
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-exp-bibtex.el155
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-expiry.el346
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-export-generic.el1385
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-git-link.el219
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-interactive-query.el310
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-invoice.el399
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-jira.el65
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-learn.el180
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-mac-iCal.el249
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-mac-link-grabber.el465
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-mairix.el332
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-man.el64
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-mime.el245
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-mtags.el257
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-panel.el642
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-registry.el271
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-screen.el108
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-secretary.el232
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-special-blocks.el94
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-static-mathjax.el171
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-toc.el488
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-track.el219
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-velocity.el527
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-wikinodes.el339
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org2rem.el653
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/orgtbl-sqlinsert.el115
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/test-org-export-preproc.el39
40 files changed, 0 insertions, 13513 deletions
diff --git a/.emacs.d/org-7.4/contrib/lisp/.DS_Store b/.emacs.d/org-7.4/contrib/lisp/.DS_Store
deleted file mode 100644
index 5008ddf..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/.DS_Store
+++ /dev/null
Binary files differ
diff --git a/.emacs.d/org-7.4/contrib/lisp/htmlize.el b/.emacs.d/org-7.4/contrib/lisp/htmlize.el
deleted file mode 100644
index 5f4cb5b..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/htmlize.el
+++ /dev/null
@@ -1,1769 +0,0 @@
-;; htmlize.el -- Convert buffer text and decorations to HTML.
-
-;; Copyright (C) 1997,1998,1999,2000,2001,2002,2003,2005,2006,2009 Hrvoje Niksic
-
-;; Author: Hrvoje Niksic <hniksic@xemacs.org>
-;; Keywords: hypermedia, extensions
-
-;; 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; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This package converts the buffer text and the associated
-;; decorations to HTML. Mail to <hniksic@xemacs.org> to discuss
-;; features and additions. All suggestions are more than welcome.
-
-;; To use this, just switch to the buffer you want HTML-ized and type
-;; `M-x htmlize-buffer'. You will be switched to a new buffer that
-;; contains the resulting HTML code. You can edit and inspect this
-;; buffer, or you can just save it with C-x C-w. `M-x htmlize-file'
-;; will find a file, fontify it, and save the HTML version in
-;; FILE.html, without any additional intervention. `M-x
-;; htmlize-many-files' allows you to htmlize any number of files in
-;; the same manner. `M-x htmlize-many-files-dired' does the same for
-;; files marked in a dired buffer.
-
-;; htmlize supports three types of HTML output, selected by setting
-;; `htmlize-output-type': `css', `inline-css', and `font'. In `css'
-;; mode, htmlize uses cascading style sheets to specify colors; it
-;; generates classes that correspond to Emacs faces and uses <span
-;; class=FACE>...</span> to color parts of text. In this mode, the
-;; produced HTML is valid under the 4.01 strict DTD, as confirmed by
-;; the W3C validator. `inline-css' is like `css', except the CSS is
-;; put directly in the STYLE attribute of the SPAN element, making it
-;; possible to paste the generated HTML to other documents. In `font'
-;; mode, htmlize uses <font color="...">...</font> to colorize HTML,
-;; which is not standard-compliant, but works better in older
-;; browsers. `css' mode is the default.
-
-;; You can also use htmlize from your Emacs Lisp code. When called
-;; non-interactively, `htmlize-buffer' and `htmlize-region' will
-;; return the resulting HTML buffer, but will not change current
-;; buffer or move the point.
-
-;; I tried to make the package elisp-compatible with multiple Emacsen,
-;; specifically aiming for XEmacs 19.14+ and GNU Emacs 19.34+. Please
-;; let me know if it doesn't work on some of those, and I'll try to
-;; fix it. I relied heavily on the presence of CL extensions,
-;; especially for cross-emacs compatibility; please don't try to
-;; remove that particular dependency. When byte-compiling under GNU
-;; Emacs, you're likely to get some warnings; just ignore them.
-
-;; The latest version should be available at:
-;;
-;; <http://fly.srk.fer.hr/~hniksic/emacs/htmlize.el>
-;;
-;; You can find a sample of htmlize's output (possibly generated with
-;; an older version) at:
-;;
-;; <http://fly.srk.fer.hr/~hniksic/emacs/htmlize.el.html>
-
-;; Thanks go to the multitudes of people who have sent reports and
-;; contributed comments, suggestions, and fixes. They include Ron
-;; Gut, Bob Weiner, Toni Drabik, Peter Breton, Thomas Vogels, Juri
-;; Linkov, Maciek Pasternacki, and many others.
-
-;; User quotes: "You sir, are a sick, sick, _sick_ person. :)"
-;; -- Bill Perry, author of Emacs/W3
-
-
-;;; Code:
-
-(require 'cl)
-(eval-when-compile
- (if (string-match "XEmacs" emacs-version)
- (byte-compiler-options
- (warnings (- unresolved))))
- (defvar font-lock-auto-fontify)
- (defvar font-lock-support-mode)
- (defvar global-font-lock-mode)
- (when (and (eq emacs-major-version 19)
- (not (string-match "XEmacs" emacs-version)))
- ;; Older versions of GNU Emacs fail to autoload cl-extra even when
- ;; `cl' is loaded.
- (load "cl-extra")))
-
-(defconst htmlize-version "1.36")
-
-;; Incantations to make custom stuff work without customize, e.g. on
-;; XEmacs 19.14 or GNU Emacs 19.34.
-(eval-and-compile
- (condition-case ()
- (require 'custom)
- (error nil))
- (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
- nil ; we've got what we needed
- ;; No custom or obsolete custom, define surrogates. Define all
- ;; three macros, so we don't hose another library that expects
- ;; e.g. `defface' to work after (fboundp 'defcustom) succeeds.
- (defmacro defgroup (&rest ignored) nil)
- (defmacro defcustom (var value doc &rest ignored)
- `(defvar ,var ,value ,doc))
- (defmacro defface (face value doc &rest stuff)
- `(make-face ,face))))
-
-(defgroup htmlize nil
- "Convert buffer text and faces to HTML."
- :group 'hypermedia)
-
-(defcustom htmlize-head-tags ""
- "*Additional tags to insert within HEAD of the generated document."
- :type 'string
- :group 'htmlize)
-
-(defcustom htmlize-output-type 'css
- "*Output type of generated HTML, one of `css', `inline-css', or `font'.
-When set to `css' (the default), htmlize will generate a style sheet
-with description of faces, and use it in the HTML document, specifying
-the faces in the actual text with <span class=\"FACE\">.
-
-When set to `inline-css', the style will be generated as above, but
-placed directly in the STYLE attribute of the span ELEMENT: <span
-style=\"STYLE\">. This makes it easier to paste the resulting HTML to
-other documents.
-
-When set to `font', the properties will be set using layout tags
-<font>, <b>, <i>, <u>, and <strike>.
-
-`css' output is normally preferred, but `font' is still useful for
-supporting old, pre-CSS browsers, and both `inline-css' and `font' for
-easier embedding of colorized text in foreign HTML documents (no style
-sheet to carry around)."
- :type '(choice (const css) (const inline-css) (const font))
- :group 'htmlize)
-
-(defcustom htmlize-generate-hyperlinks t
- "*Non-nil means generate the hyperlinks for URLs and mail addresses.
-This is on by default; set it to nil if you don't want htmlize to
-insert hyperlinks in the resulting HTML. (In which case you can still
-do your own hyperlinkification from htmlize-after-hook.)"
- :type 'boolean
- :group 'htmlize)
-
-(defcustom htmlize-hyperlink-style "
- a {
- color: inherit;
- background-color: inherit;
- font: inherit;
- text-decoration: inherit;
- }
- a:hover {
- text-decoration: underline;
- }
-"
- "*The CSS style used for hyperlinks when in CSS mode."
- :type 'string
- :group 'htmlize)
-
-(defcustom htmlize-replace-form-feeds t
- "*Non-nil means replace form feeds in source code with HTML separators.
-Form feeds are the ^L characters at line beginnings that are sometimes
-used to separate sections of source code. If this variable is set to
-`t', form feed characters are replaced with the <hr> separator. If this
-is a string, it specifies the replacement to use. Note that <pre> is
-temporarily closed before the separator is inserted, so the default
-replacement is effectively \"</pre><hr /><pre>\". If you specify
-another replacement, don't forget to close and reopen the <pre> if you
-want the output to remain valid HTML.
-
-If you need more elaborate processing, set this to nil and use
-htmlize-after-hook."
- :type 'boolean
- :group 'htmlize)
-
-(defcustom htmlize-html-charset nil
- "*The charset declared by the resulting HTML documents.
-When non-nil, causes htmlize to insert the following in the HEAD section
-of the generated HTML:
-
- <meta http-equiv=\"Content-Type\" content=\"text/html; charset=CHARSET\">
-
-where CHARSET is the value you've set for htmlize-html-charset. Valid
-charsets are defined by MIME and include strings like \"iso-8859-1\",
-\"iso-8859-15\", \"utf-8\", etc.
-
-If you are using non-Latin-1 charsets, you might need to set this for
-your documents to render correctly. Also, the W3C validator requires
-submitted HTML documents to declare a charset. So if you care about
-validation, you can use this to prevent the validator from bitching.
-
-Needless to say, if you set this, you should actually make sure that
-the buffer is in the encoding you're claiming it is in. (Under Mule
-that is done by ensuring the correct \"file coding system\" for the
-buffer.) If you don't understand what that means, this option is
-probably not for you."
- :type '(choice (const :tag "Unset" nil)
- string)
- :group 'htmlize)
-
-(defcustom htmlize-convert-nonascii-to-entities (featurep 'mule)
- "*Whether non-ASCII characters should be converted to HTML entities.
-
-When this is non-nil, characters with codes in the 128-255 range will be
-considered Latin 1 and rewritten as \"&#CODE;\". Characters with codes
-above 255 will be converted to \"&#UCS;\", where UCS denotes the Unicode
-code point of the character. If the code point cannot be determined,
-the character will be copied unchanged, as would be the case if the
-option were nil.
-
-When the option is nil, the non-ASCII characters are copied to HTML
-without modification. In that case, the web server and/or the browser
-must be set to understand the encoding that was used when saving the
-buffer. (You might also want to specify it by setting
-`htmlize-html-charset'.)
-
-Note that in an HTML entity \"&#CODE;\", CODE is always a UCS code point,
-which has nothing to do with the charset the page is in. For example,
-\"&#169;\" *always* refers to the copyright symbol, regardless of charset
-specified by the META tag or the charset sent by the HTTP server. In
-other words, \"&#169;\" is exactly equivalent to \"&copy;\".
-
-By default, entity conversion is turned on for Mule-enabled Emacsen and
-turned off otherwise. This is because Mule knows the charset of
-non-ASCII characters in the buffer. A non-Mule Emacs cannot tell
-whether a character with code 0xA9 represents Latin 1 copyright symbol,
-Latin 2 \"S with caron\", or something else altogether. Setting this to
-t without Mule means asserting that 128-255 characters always mean Latin
-1.
-
-For most people htmlize will work fine with this option left at the
-default setting; don't change it unless you know what you're doing."
- :type 'sexp
- :group 'htmlize)
-
-(defcustom htmlize-ignore-face-size 'absolute
- "*Whether face size should be ignored when generating HTML.
-If this is nil, face sizes are used. If set to t, sizes are ignored
-If set to `absolute', only absolute size specifications are ignored.
-Please note that font sizes only work with CSS-based output types."
- :type '(choice (const :tag "Don't ignore" nil)
- (const :tag "Ignore all" t)
- (const :tag "Ignore absolute" absolute))
- :group 'htmlize)
-
-(defcustom htmlize-css-name-prefix ""
- "*The prefix used for CSS names.
-The CSS names that htmlize generates from face names are often too
-generic for CSS files; for example, `font-lock-type-face' is transformed
-to `type'. Use this variable to add a prefix to the generated names.
-The string \"htmlize-\" is an example of a reasonable prefix."
- :type 'string
- :group 'htmlize)
-
-(defcustom htmlize-use-rgb-txt t
- "*Whether `rgb.txt' should be used to convert color names to RGB.
-
-This conversion means determining, for instance, that the color
-\"IndianRed\" corresponds to the (205, 92, 92) RGB triple. `rgb.txt'
-is the X color database that maps hundreds of color names to such RGB
-triples. When this variable is non-nil, `htmlize' uses `rgb.txt' to
-look up color names.
-
-If this variable is nil, htmlize queries Emacs for RGB components of
-colors using `color-instance-rgb-components' and `x-color-values'.
-This can yield incorrect results on non-true-color displays.
-
-If the `rgb.txt' file is not found (which will be the case if you're
-running Emacs on non-X11 systems), this option is ignored."
- :type 'boolean
- :group 'htmlize)
-
-(defcustom htmlize-html-major-mode nil
- "The mode the newly created HTML buffer will be put in.
-Set this to nil if you prefer the default (fundamental) mode."
- :type '(radio (const :tag "No mode (fundamental)" nil)
- (function-item html-mode)
- (function :tag "User-defined major mode"))
- :group 'htmlize)
-
-(defvar htmlize-before-hook nil
- "Hook run before htmlizing a buffer.
-The hook functions are run in the source buffer (not the resulting HTML
-buffer).")
-
-(defvar htmlize-after-hook nil
- "Hook run after htmlizing a buffer.
-Unlike `htmlize-before-hook', these functions are run in the generated
-HTML buffer. You may use them to modify the outlook of the final HTML
-output.")
-
-(defvar htmlize-file-hook nil
- "Hook run by `htmlize-file' after htmlizing a file, but before saving it.")
-
-(defvar htmlize-buffer-places)
-
-;;; Some cross-Emacs compatibility.
-
-;; I try to conditionalize on features rather than Emacs version, but
-;; in some cases checking against the version *is* necessary.
-(defconst htmlize-running-xemacs (string-match "XEmacs" emacs-version))
-
-(eval-and-compile
- ;; save-current-buffer, with-current-buffer, and with-temp-buffer
- ;; are not available in 19.34 and in older XEmacsen. Strictly
- ;; speaking, we should stick to our own namespace and define and use
- ;; htmlize-save-current-buffer, etc. But non-standard special forms
- ;; are a pain because they're not properly fontified or indented and
- ;; because they look weird and ugly. So I'll just go ahead and
- ;; define the real ones if they're not available. If someone
- ;; convinces me that this breaks something, I'll switch to the
- ;; "htmlize-" namespace.
- (unless (fboundp 'save-current-buffer)
- (defmacro save-current-buffer (&rest forms)
- `(let ((__scb_current (current-buffer)))
- (unwind-protect
- (progn ,@forms)
- (set-buffer __scb_current)))))
- (unless (fboundp 'with-current-buffer)
- (defmacro with-current-buffer (buffer &rest forms)
- `(save-current-buffer (set-buffer ,buffer) ,@forms)))
- (unless (fboundp 'with-temp-buffer)
- (defmacro with-temp-buffer (&rest forms)
- (let ((temp-buffer (gensym "tb-")))
- `(let ((,temp-buffer
- (get-buffer-create (generate-new-buffer-name " *temp*"))))
- (unwind-protect
- (with-current-buffer ,temp-buffer
- ,@forms)
- (and (buffer-live-p ,temp-buffer)
- (kill-buffer ,temp-buffer))))))))
-
-;; We need a function that efficiently finds the next change of a
-;; property (usually `face'), preferably regardless of whether the
-;; change occurred because of a text property or an extent/overlay.
-;; As it turns out, it is not easy to do that compatibly.
-;;
-;; Under XEmacs, `next-single-property-change' does that. Under GNU
-;; Emacs beginning with version 21, `next-single-char-property-change'
-;; is available and does the same. GNU Emacs 20 had
-;; `next-char-property-change', which we can use. GNU Emacs 19 didn't
-;; provide any means for simultaneously examining overlays and text
-;; properties, so when using Emacs 19.34, we punt and fall back to
-;; `next-single-property-change', thus ignoring overlays altogether.
-
-(cond
- (htmlize-running-xemacs
- ;; XEmacs: good.
- (defun htmlize-next-change (pos prop &optional limit)
- (next-single-property-change pos prop nil (or limit (point-max)))))
- ((fboundp 'next-single-char-property-change)
- ;; GNU Emacs 21: good.
- (defun htmlize-next-change (pos prop &optional limit)
- (next-single-char-property-change pos prop nil limit)))
- ((fboundp 'next-char-property-change)
- ;; GNU Emacs 20: bad, but fixable.
- (defun htmlize-next-change (pos prop &optional limit)
- (let ((done nil)
- (current-value (get-char-property pos prop))
- newpos next-value)
- ;; Loop over positions returned by next-char-property-change
- ;; until the value of PROP changes or we've hit EOB.
- (while (not done)
- (setq newpos (next-char-property-change pos limit)
- next-value (get-char-property newpos prop))
- (cond ((eq newpos pos)
- ;; Possibly at EOB? Whatever, just don't infloop.
- (setq done t))
- ((eq next-value current-value)
- ;; PROP hasn't changed -- keep looping.
- )
- (t
- (setq done t)))
- (setq pos newpos))
- pos)))
- (t
- ;; GNU Emacs 19.34: hopeless, cannot properly support overlays.
- (defun htmlize-next-change (pos prop &optional limit)
- (unless limit
- (setq limit (point-max)))
- (let ((res (next-single-property-change pos prop)))
- (if (or (null res)
- (> res limit))
- limit
- res)))))
-
-;;; Transformation of buffer text: HTML escapes, untabification, etc.
-
-(defvar htmlize-basic-character-table
- ;; Map characters in the 0-127 range to either one-character strings
- ;; or to numeric entities.
- (let ((table (make-vector 128 ?\0)))
- ;; Map characters in the 32-126 range to themselves, others to
- ;; &#CODE entities;
- (dotimes (i 128)
- (setf (aref table i) (if (and (>= i 32) (<= i 126))
- (char-to-string i)
- (format "&#%d;" i))))
- ;; Set exceptions manually.
- (setf
- ;; Don't escape newline, carriage return, and TAB.
- (aref table ?\n) "\n"
- (aref table ?\r) "\r"
- (aref table ?\t) "\t"
- ;; Escape &, <, and >.
- (aref table ?&) "&amp;"
- (aref table ?<) "&lt;"
- (aref table ?>) "&gt;"
- ;; Not escaping '"' buys us a measurable speedup. It's only
- ;; necessary to quote it for strings used in attribute values,
- ;; which htmlize doesn't do.
- ;(aref table ?\") "&quot;"
- )
- table))
-
-;; A cache of HTML representation of non-ASCII characters. Depending
-;; on availability of `encode-char' and the setting of
-;; `htmlize-convert-nonascii-to-entities', this maps non-ASCII
-;; characters to either "&#<code>;" or "<char>" (mapconcat's mapper
-;; must always return strings). It's only filled as characters are
-;; encountered, so that in a buffer with e.g. French text, it will
-;; only ever contain French accented characters as keys. It's cleared
-;; on each entry to htmlize-buffer-1 to allow modifications of
-;; `htmlize-convert-nonascii-to-entities' to take effect.
-(defvar htmlize-extended-character-cache (make-hash-table :test 'eq))
-
-(defun htmlize-protect-string (string)
- "HTML-protect string, escaping HTML metacharacters and I18N chars."
- ;; Only protecting strings that actually contain unsafe or non-ASCII
- ;; chars removes a lot of unnecessary funcalls and consing.
- (if (not (string-match "[^\r\n\t -%'-;=?-~]" string))
- string
- (mapconcat (lambda (char)
- (cond
- ((< char 128)
- ;; ASCII: use htmlize-basic-character-table.
- (aref htmlize-basic-character-table char))
- ((gethash char htmlize-extended-character-cache)
- ;; We've already seen this char; return the cached
- ;; string.
- )
- ((not htmlize-convert-nonascii-to-entities)
- ;; If conversion to entities is not desired, always
- ;; copy the char literally.
- (setf (gethash char htmlize-extended-character-cache)
- (char-to-string char)))
- ((< char 256)
- ;; Latin 1: no need to call encode-char.
- (setf (gethash char htmlize-extended-character-cache)
- (format "&#%d;" char)))
- ((and (fboundp 'encode-char)
- ;; Must check if encode-char works for CHAR;
- ;; it fails for Arabic and possibly elsewhere.
- (encode-char char 'ucs))
- (setf (gethash char htmlize-extended-character-cache)
- (format "&#%d;" (encode-char char 'ucs))))
- (t
- ;; encode-char doesn't work for this char. Copy it
- ;; unchanged and hope for the best.
- (setf (gethash char htmlize-extended-character-cache)
- (char-to-string char)))))
- string "")))
-
-(defconst htmlize-ellipsis "...")
-(put-text-property 0 (length htmlize-ellipsis) 'htmlize-ellipsis t htmlize-ellipsis)
-
-(defun htmlize-buffer-substring-no-invisible (beg end)
- ;; Like buffer-substring-no-properties, but don't copy invisible
- ;; parts of the region. Where buffer-substring-no-properties
- ;; mandates an ellipsis to be shown, htmlize-ellipsis is inserted.
- (let ((pos beg)
- visible-list invisible show next-change)
- ;; Iterate over the changes in the `invisible' property and filter
- ;; out the portions where it's non-nil, i.e. where the text is
- ;; invisible.
- (while (< pos end)
- (setq invisible (get-char-property pos 'invisible)
- next-change (htmlize-next-change pos 'invisible end))
- (if (not (listp buffer-invisibility-spec))
- ;; If buffer-invisibility-spec is not a list, then all
- ;; characters with non-nil `invisible' property are visible.
- (setq show (not invisible))
- ;; Otherwise, the value of a non-nil `invisible' property can be:
- ;; 1. a symbol -- make the text invisible if it matches
- ;; buffer-invisibility-spec.
- ;; 2. a list of symbols -- make the text invisible if
- ;; any symbol in the list matches
- ;; buffer-invisibility-spec.
- ;; If the match of buffer-invisibility-spec has a non-nil
- ;; CDR, replace the invisible text with an ellipsis.
- (let (match)
- (if (symbolp invisible)
- (setq match (member* invisible buffer-invisibility-spec
- :key (lambda (i)
- (if (symbolp i) i (car i)))))
- (setq match (block nil
- (dolist (elem invisible)
- (let ((m (member*
- elem buffer-invisibility-spec
- :key (lambda (i)
- (if (symbolp i) i (car i))))))
- (when m (return m))))
- nil)))
- (setq show (cond ((null match) t)
- ((and (cdr-safe (car match))
- ;; Conflate successive ellipses.
- (not (eq show htmlize-ellipsis)))
- htmlize-ellipsis)
- (t nil)))))
- (cond ((eq show t)
- (push (buffer-substring-no-properties pos next-change) visible-list))
- ((stringp show)
- (push show visible-list)))
- (setq pos next-change))
- (if (= (length visible-list) 1)
- ;; If VISIBLE-LIST consists of only one element, return it
- ;; without concatenation. This avoids additional consing in
- ;; regions without any invisible text.
- (car visible-list)
- (apply #'concat (nreverse visible-list)))))
-
-(defun htmlize-trim-ellipsis (text)
- ;; Remove htmlize-ellipses ("...") from the beginning of TEXT if it
- ;; starts with it. It checks for the special property of the
- ;; ellipsis so it doesn't work on ordinary text that begins with
- ;; "...".
- (if (get-text-property 0 'htmlize-ellipsis text)
- (substring text (length htmlize-ellipsis))
- text))
-
-(defconst htmlize-tab-spaces
- ;; A table of strings with spaces. (aref htmlize-tab-spaces 5) is
- ;; like (make-string 5 ?\ ), except it doesn't cons.
- (let ((v (make-vector 32 nil)))
- (dotimes (i (length v))
- (setf (aref v i) (make-string i ?\ )))
- v))
-
-(defun htmlize-untabify (text start-column)
- "Untabify TEXT, assuming it starts at START-COLUMN."
- (let ((column start-column)
- (last-match 0)
- (chunk-start 0)
- chunks match-pos tab-size)
- (while (string-match "[\t\n]" text last-match)
- (setq match-pos (match-beginning 0))
- (cond ((eq (aref text match-pos) ?\t)
- ;; Encountered a tab: create a chunk of text followed by
- ;; the expanded tab.
- (push (substring text chunk-start match-pos) chunks)
- ;; Increase COLUMN by the length of the text we've
- ;; skipped since last tab or newline. (Encountering
- ;; newline resets it.)
- (incf column (- match-pos last-match))
- ;; Calculate tab size based on tab-width and COLUMN.
- (setq tab-size (- tab-width (% column tab-width)))
- ;; Expand the tab.
- (push (aref htmlize-tab-spaces tab-size) chunks)
- (incf column tab-size)
- (setq chunk-start (1+ match-pos)))
- (t
- ;; Reset COLUMN at beginning of line.
- (setq column 0)))
- (setq last-match (1+ match-pos)))
- ;; If no chunks have been allocated, it means there have been no
- ;; tabs to expand. Return TEXT unmodified.
- (if (null chunks)
- text
- (when (< chunk-start (length text))
- ;; Push the remaining chunk.
- (push (substring text chunk-start) chunks))
- ;; Generate the output from the available chunks.
- (apply #'concat (nreverse chunks)))))
-
-(defun htmlize-despam-address (string)
- "Replace every occurrence of '@' in STRING with &#64;.
-`htmlize-make-hyperlinks' uses this to spam-protect mailto links
-without modifying their meaning."
- ;; Suggested by Ville Skytta.
- (while (string-match "@" string)
- (setq string (replace-match "&#64;" nil t string)))
- string)
-
-(defun htmlize-make-hyperlinks ()
- "Make hyperlinks in HTML."
- ;; Function originally submitted by Ville Skytta. Rewritten by
- ;; Hrvoje Niksic, then modified by Ville Skytta and Hrvoje Niksic.
- (goto-char (point-min))
- (while (re-search-forward
- "&lt;\\(\\(mailto:\\)?\\([-=+_.a-zA-Z0-9]+@[-_.a-zA-Z0-9]+\\)\\)&gt;"
- nil t)
- (let ((address (match-string 3))
- (link-text (match-string 1)))
- (delete-region (match-beginning 0) (match-end 0))
- (insert "&lt;<a href=\"mailto:"
- (htmlize-despam-address address)
- "\">"
- (htmlize-despam-address link-text)
- "</a>&gt;")))
- (goto-char (point-min))
- (while (re-search-forward "&lt;\\(\\(URL:\\)?\\([a-zA-Z]+://[^;]+\\)\\)&gt;"
- nil t)
- (let ((url (match-string 3))
- (link-text (match-string 1)))
- (delete-region (match-beginning 0) (match-end 0))
- (insert "&lt;<a href=\"" url "\">" link-text "</a>&gt;"))))
-
-;; Tests for htmlize-make-hyperlinks:
-
-;; <mailto:hniksic@xemacs.org>
-;; <http://fly.srk.fer.hr>
-;; <URL:http://www.xemacs.org>
-;; <http://www.mail-archive.com/bbdb-info@xemacs.org/>
-;; <hniksic@xemacs.org>
-;; <xalan-dev-sc.10148567319.hacuhiucknfgmpfnjcpg-john=doe.com@xml.apache.org>
-
-(defun htmlize-defang-local-variables ()
- ;; Juri Linkov reports that an HTML-ized "Local variables" can lead
- ;; visiting the HTML to fail with "Local variables list is not
- ;; properly terminated". He suggested changing the phrase to
- ;; syntactically equivalent HTML that Emacs doesn't recognize.
- (goto-char (point-min))
- (while (search-forward "Local Variables:" nil t)
- (replace-match "Local Variables&#58;" nil t)))
-
-
-;;; Color handling.
-
-(if (fboundp 'locate-file)
- (defalias 'htmlize-locate-file 'locate-file)
- (defun htmlize-locate-file (file path)
- (dolist (dir path nil)
- (when (file-exists-p (expand-file-name file dir))
- (return (expand-file-name file dir))))))
-
-(defvar htmlize-x-library-search-path
- '("/usr/X11R6/lib/X11/"
- "/usr/X11R5/lib/X11/"
- "/usr/lib/X11R6/X11/"
- "/usr/lib/X11R5/X11/"
- "/usr/local/X11R6/lib/X11/"
- "/usr/local/X11R5/lib/X11/"
- "/usr/local/lib/X11R6/X11/"
- "/usr/local/lib/X11R5/X11/"
- "/usr/X11/lib/X11/"
- "/usr/lib/X11/"
- "/usr/local/lib/X11/"
- "/usr/X386/lib/X11/"
- "/usr/x386/lib/X11/"
- "/usr/XFree86/lib/X11/"
- "/usr/unsupported/lib/X11/"
- "/usr/athena/lib/X11/"
- "/usr/local/x11r5/lib/X11/"
- "/usr/lpp/Xamples/lib/X11/"
- "/usr/openwin/lib/X11/"
- "/usr/openwin/share/lib/X11/"))
-
-(defun htmlize-get-color-rgb-hash (&optional rgb-file)
- "Return a hash table mapping X color names to RGB values.
-The keys in the hash table are X11 color names, and the values are the
-#rrggbb RGB specifications, extracted from `rgb.txt'.
-
-If RGB-FILE is nil, the function will try hard to find a suitable file
-in the system directories.
-
-If no rgb.txt file is found, return nil."
- (let ((rgb-file (or rgb-file (htmlize-locate-file
- "rgb.txt"
- htmlize-x-library-search-path)))
- (hash nil))
- (when rgb-file
- (with-temp-buffer
- (insert-file-contents rgb-file)
- (setq hash (make-hash-table :test 'equal))
- (while (not (eobp))
- (cond ((looking-at "^\\s-*\\([!#]\\|$\\)")
- ;; Skip comments and empty lines.
- )
- ((looking-at
- "[ \t]*\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\(.*\\)")
- (setf (gethash (downcase (match-string 4)) hash)
- (format "#%02x%02x%02x"
- (string-to-number (match-string 1))
- (string-to-number (match-string 2))
- (string-to-number (match-string 3)))))
- (t
- (error
- "Unrecognized line in %s: %s"
- rgb-file
- (buffer-substring (point) (progn (end-of-line) (point))))))
- (forward-line 1))))
- hash))
-
-;; Compile the RGB map when loaded. On systems where rgb.txt is
-;; missing, the value of the variable will be nil, and rgb.txt will
-;; not be used.
-(defvar htmlize-color-rgb-hash (htmlize-get-color-rgb-hash))
-
-;;; Face handling.
-
-(defun htmlize-face-specifies-property (face prop)
- ;; Return t if face specifies PROP, as opposed to it being inherited
- ;; from the default face. The problem with e.g.
- ;; `face-foreground-instance' is that it returns an instance for
- ;; EVERY face because every face inherits from the default face.
- ;; However, we'd like htmlize-face-{fore,back}ground to return nil
- ;; when called with a face that doesn't specify its own foreground
- ;; or background.
- (or (eq face 'default)
- (assq 'global (specifier-spec-list (face-property face prop)))))
-
-(defun htmlize-face-color-internal (face fg)
- ;; Used only under GNU Emacs. Return the color of FACE, but don't
- ;; return "unspecified-fg" or "unspecified-bg". If the face is
- ;; `default' and the color is unspecified, look up the color in
- ;; frame parameters.
- (let* ((function (if fg #'face-foreground #'face-background))
- color)
- (if (>= emacs-major-version 22)
- ;; For GNU Emacs 22+ set INHERIT to get the inherited values.
- (setq color (funcall function face nil t))
- (setq color (funcall function face))
- ;; For GNU Emacs 21 (which has `face-attribute'): if the color
- ;; is nil, recursively check for the face's parent.
- (when (and (null color)
- (fboundp 'face-attribute)
- (face-attribute face :inherit)
- (not (eq (face-attribute face :inherit) 'unspecified)))
- (setq color (htmlize-face-color-internal
- (face-attribute face :inherit) fg))))
- (when (and (eq face 'default) (null color))
- (setq color (cdr (assq (if fg 'foreground-color 'background-color)
- (frame-parameters)))))
- (when (or (eq color 'unspecified)
- (equal color "unspecified-fg")
- (equal color "unspecified-bg"))
- (setq color nil))
- (when (and (eq face 'default)
- (null color))
- ;; Assuming black on white doesn't seem right, but I can't think
- ;; of anything better to do.
- (setq color (if fg "black" "white")))
- color))
-
-(defun htmlize-face-foreground (face)
- ;; Return the name of the foreground color of FACE. If FACE does
- ;; not specify a foreground color, return nil.
- (cond (htmlize-running-xemacs
- ;; XEmacs.
- (and (htmlize-face-specifies-property face 'foreground)
- (color-instance-name (face-foreground-instance face))))
- (t
- ;; GNU Emacs.
- (htmlize-face-color-internal face t))))
-
-(defun htmlize-face-background (face)
- ;; Return the name of the background color of FACE. If FACE does
- ;; not specify a background color, return nil.
- (cond (htmlize-running-xemacs
- ;; XEmacs.
- (and (htmlize-face-specifies-property face 'background)
- (color-instance-name (face-background-instance face))))
- (t
- ;; GNU Emacs.
- (htmlize-face-color-internal face nil))))
-
-;; Convert COLOR to the #RRGGBB string. If COLOR is already in that
-;; format, it's left unchanged.
-
-(defun htmlize-color-to-rgb (color)
- (let ((rgb-string nil))
- (cond ((null color)
- ;; Ignore nil COLOR because it means that the face is not
- ;; specifying any color. Hence (htmlize-color-to-rgb nil)
- ;; returns nil.
- )
- ((string-match "\\`#" color)
- ;; The color is already in #rrggbb format.
- (setq rgb-string color))
- ((and htmlize-use-rgb-txt
- htmlize-color-rgb-hash)
- ;; Use of rgb.txt is requested, and it's available on the
- ;; system. Use it.
- (setq rgb-string (gethash (downcase color) htmlize-color-rgb-hash)))
- (t
- ;; We're getting the RGB components from Emacs.
- (let ((rgb
- ;; Here I cannot conditionalize on (fboundp ...)
- ;; because ps-print under some versions of GNU Emacs
- ;; defines its own dummy version of
- ;; `color-instance-rgb-components'.
- (if htmlize-running-xemacs
- (mapcar (lambda (arg)
- (/ arg 256))
- (color-instance-rgb-components
- (make-color-instance color)))
- (mapcar (lambda (arg)
- (/ arg 256))
- (x-color-values color)))))
- (when rgb
- (setq rgb-string (apply #'format "#%02x%02x%02x" rgb))))))
- ;; If RGB-STRING is still nil, it means the color cannot be found,
- ;; for whatever reason. In that case just punt and return COLOR.
- ;; Most browsers support a decent set of color names anyway.
- (or rgb-string color)))
-
-;; We store the face properties we care about into an
-;; `htmlize-fstruct' type. That way we only have to analyze face
-;; properties, which can be time consuming, once per each face. The
-;; mapping between Emacs faces and htmlize-fstructs is established by
-;; htmlize-make-face-map. The name "fstruct" refers to variables of
-;; type `htmlize-fstruct', while the term "face" is reserved for Emacs
-;; faces.
-
-(defstruct htmlize-fstruct
- foreground ; foreground color, #rrggbb
- background ; background color, #rrggbb
- size ; size
- boldp ; whether face is bold
- italicp ; whether face is italic
- underlinep ; whether face is underlined
- overlinep ; whether face is overlined
- strikep ; whether face is struck through
- css-name ; CSS name of face
- )
-
-(defun htmlize-face-emacs21-attr (fstruct attr value)
- ;; For ATTR and VALUE, set the equivalent value in FSTRUCT.
- (case attr
- (:foreground
- (setf (htmlize-fstruct-foreground fstruct) (htmlize-color-to-rgb value)))
- (:background
- (setf (htmlize-fstruct-background fstruct) (htmlize-color-to-rgb value)))
- (:height
- (setf (htmlize-fstruct-size fstruct) value))
- (:weight
- (when (string-match (symbol-name value) "bold")
- (setf (htmlize-fstruct-boldp fstruct) t)))
- (:slant
- (setf (htmlize-fstruct-italicp fstruct) (or (eq value 'italic)
- (eq value 'oblique))))
- (:bold
- (setf (htmlize-fstruct-boldp fstruct) value))
- (:italic
- (setf (htmlize-fstruct-italicp fstruct) value))
- (:underline
- (setf (htmlize-fstruct-underlinep fstruct) value))
- (:overline
- (setf (htmlize-fstruct-overlinep fstruct) value))
- (:strike-through
- (setf (htmlize-fstruct-strikep fstruct) value))))
-
-(defun htmlize-face-size (face)
- ;; The size (height) of FACE, taking inheritance into account.
- ;; Only works in Emacs 21 and later.
- (let ((size-list
- (loop
- for f = face then (ignore-errors (face-attribute f :inherit)) ;?????
- until (or (not f) (eq f 'unspecified))
- for h = (ignore-errors (face-attribute f :height)) ;???????
- collect (if (eq h 'unspecified) nil h))))
- (reduce 'htmlize-merge-size (cons nil size-list))))
-
-(defun htmlize-face-to-fstruct (face)
- "Convert Emacs face FACE to fstruct."
- (let ((fstruct (make-htmlize-fstruct
- :foreground (htmlize-color-to-rgb
- (htmlize-face-foreground face))
- :background (htmlize-color-to-rgb
- (htmlize-face-background face)))))
- (cond (htmlize-running-xemacs
- ;; XEmacs doesn't provide a way to detect whether a face is
- ;; bold or italic, so we need to examine the font instance.
- ;; #### This probably doesn't work under MS Windows and/or
- ;; GTK devices. I'll need help with those.
- (let* ((font-instance (face-font-instance face))
- (props (font-instance-properties font-instance)))
- (when (equalp (cdr (assq 'WEIGHT_NAME props)) "bold")
- (setf (htmlize-fstruct-boldp fstruct) t))
- (when (or (equalp (cdr (assq 'SLANT props)) "i")
- (equalp (cdr (assq 'SLANT props)) "o"))
- (setf (htmlize-fstruct-italicp fstruct) t))
- (setf (htmlize-fstruct-strikep fstruct)
- (face-strikethru-p face))
- (setf (htmlize-fstruct-underlinep fstruct)
- (face-underline-p face))))
- ((fboundp 'face-attribute)
- ;; GNU Emacs 21 and further.
- (dolist (attr '(:weight :slant :underline :overline :strike-through))
- (let ((value (if (>= emacs-major-version 22)
- ;; Use the INHERIT arg in GNU Emacs 22.
- (face-attribute face attr nil t)
- ;; Otherwise, fake it.
- (let ((face face))
- (while (and (eq (face-attribute face attr)
- 'unspecified)
- (not (eq (face-attribute face :inherit)
- 'unspecified)))
- (setq face (face-attribute face :inherit)))
- (face-attribute face attr)))))
- (when (and value (not (eq value 'unspecified)))
- (htmlize-face-emacs21-attr fstruct attr value))))
- (let ((size (htmlize-face-size face)))
- (unless (eql size 1.0) ; ignore non-spec
- (setf (htmlize-fstruct-size fstruct) size))))
- (t
- ;; Older GNU Emacs. Some of these functions are only
- ;; available under Emacs 20+, hence the guards.
- (when (fboundp 'face-bold-p)
- (setf (htmlize-fstruct-boldp fstruct) (face-bold-p face)))
- (when (fboundp 'face-italic-p)
- (setf (htmlize-fstruct-italicp fstruct) (face-italic-p face)))
- (setf (htmlize-fstruct-underlinep fstruct)
- (face-underline-p face))))
- ;; Generate the css-name property. Emacs places no restrictions
- ;; on the names of symbols that represent faces -- any characters
- ;; may be in the name, even ^@. We try hard to beat the face name
- ;; into shape, both esthetically and according to CSS1 specs.
- (setf (htmlize-fstruct-css-name fstruct)
- (let ((name (downcase (symbol-name face))))
- (when (string-match "\\`font-lock-" name)
- ;; Change font-lock-FOO-face to FOO.
- (setq name (replace-match "" t t name)))
- (when (string-match "-face\\'" name)
- ;; Drop the redundant "-face" suffix.
- (setq name (replace-match "" t t name)))
- (while (string-match "[^-a-zA-Z0-9]" name)
- ;; Drop the non-alphanumerics.
- (setq name (replace-match "X" t t name)))
- (when (string-match "\\`[-0-9]" name)
- ;; CSS identifiers may not start with a digit.
- (setq name (concat "X" name)))
- ;; After these transformations, the face could come
- ;; out empty.
- (when (equal name "")
- (setq name "face"))
- ;; Apply the prefix.
- (setq name (concat htmlize-css-name-prefix name))
- name))
- fstruct))
-
-(defmacro htmlize-copy-attr-if-set (attr-list dest source)
- ;; Expand the code of the type
- ;; (and (htmlize-fstruct-ATTR source)
- ;; (setf (htmlize-fstruct-ATTR dest) (htmlize-fstruct-ATTR source)))
- ;; for the given list of boolean attributes.
- (cons 'progn
- (loop for attr in attr-list
- for attr-sym = (intern (format "htmlize-fstruct-%s" attr))
- collect `(and (,attr-sym ,source)
- (setf (,attr-sym ,dest) (,attr-sym ,source))))))
-
-(defun htmlize-merge-size (merged next)
- ;; Calculate the size of the merge of MERGED and NEXT.
- (cond ((null merged) next)
- ((integerp next) next)
- ((null next) merged)
- ((floatp merged) (* merged next))
- ((integerp merged) (round (* merged next)))))
-
-(defun htmlize-merge-two-faces (merged next)
- (htmlize-copy-attr-if-set
- (foreground background boldp italicp underlinep overlinep strikep)
- merged next)
- (setf (htmlize-fstruct-size merged)
- (htmlize-merge-size (htmlize-fstruct-size merged)
- (htmlize-fstruct-size next)))
- merged)
-
-(defun htmlize-merge-faces (fstruct-list)
- (cond ((null fstruct-list)
- ;; Nothing to do, return a dummy face.
- (make-htmlize-fstruct))
- ((null (cdr fstruct-list))
- ;; Optimize for the common case of a single face, simply
- ;; return it.
- (car fstruct-list))
- (t
- (reduce #'htmlize-merge-two-faces
- (cons (make-htmlize-fstruct) fstruct-list)))))
-
-;; GNU Emacs 20+ supports attribute lists in `face' properties. For
-;; example, you can use `(:foreground "red" :weight bold)' as an
-;; overlay's "face", or you can even use a list of such lists, etc.
-;; We call those "attrlists".
-;;
-;; htmlize supports attrlist by converting them to fstructs, the same
-;; as with regular faces.
-
-(defun htmlize-attrlist-to-fstruct (attrlist)
- ;; Like htmlize-face-to-fstruct, but accepts an ATTRLIST as input.
- (let ((fstruct (make-htmlize-fstruct)))
- (cond ((eq (car attrlist) 'foreground-color)
- ;; ATTRLIST is (foreground-color . COLOR)
- (setf (htmlize-fstruct-foreground fstruct)
- (htmlize-color-to-rgb (cdr attrlist))))
- ((eq (car attrlist) 'background-color)
- ;; ATTRLIST is (background-color . COLOR)
- (setf (htmlize-fstruct-background fstruct)
- (htmlize-color-to-rgb (cdr attrlist))))
- (t
- ;; ATTRLIST is a plist.
- (while attrlist
- (let ((attr (pop attrlist))
- (value (pop attrlist)))
- (when (and value (not (eq value 'unspecified)))
- (htmlize-face-emacs21-attr fstruct attr value))))))
- (setf (htmlize-fstruct-css-name fstruct) "ATTRLIST")
- fstruct))
-
-(defun htmlize-face-list-p (face-prop)
- "Return non-nil if FACE-PROP is a list of faces, nil otherwise."
- ;; If not for attrlists, this would return (listp face-prop). This
- ;; way we have to be more careful because attrlist is also a list!
- (cond
- ((eq face-prop nil)
- ;; FACE-PROP being nil means empty list (no face), so return t.
- t)
- ((symbolp face-prop)
- ;; A symbol other than nil means that it's only one face, so return
- ;; nil.
- nil)
- ((not (consp face-prop))
- ;; Huh? Not a symbol or cons -- treat it as a single element.
- nil)
- (t
- ;; We know that FACE-PROP is a cons: check whether it looks like an
- ;; ATTRLIST.
- (let* ((car (car face-prop))
- (attrlist-p (and (symbolp car)
- (or (eq car 'foreground-color)
- (eq car 'background-color)
- (eq (aref (symbol-name car) 0) ?:)))))
- ;; If FACE-PROP is not an ATTRLIST, it means it's a list of
- ;; faces.
- (not attrlist-p)))))
-
-(defun htmlize-make-face-map (faces)
- ;; Return a hash table mapping Emacs faces to htmlize's fstructs.
- ;; The keys are either face symbols or attrlists, so the test
- ;; function must be `equal'.
- (let ((face-map (make-hash-table :test 'equal))
- css-names)
- (dolist (face faces)
- (unless (gethash face face-map)
- ;; Haven't seen FACE yet; convert it to an fstruct and cache
- ;; it.
- (let ((fstruct (if (symbolp face)
- (htmlize-face-to-fstruct face)
- (htmlize-attrlist-to-fstruct face))))
- (setf (gethash face face-map) fstruct)
- (let* ((css-name (htmlize-fstruct-css-name fstruct))
- (new-name css-name)
- (i 0))
- ;; Uniquify the face's css-name by using NAME-1, NAME-2,
- ;; etc.
- (while (member new-name css-names)
- (setq new-name (format "%s-%s" css-name (incf i))))
- (unless (equal new-name css-name)
- (setf (htmlize-fstruct-css-name fstruct) new-name))
- (push new-name css-names)))))
- face-map))
-
-(defun htmlize-unstringify-face (face)
- "If FACE is a string, return it interned, otherwise return it unchanged."
- (if (stringp face)
- (intern face)
- face))
-
-(defun htmlize-faces-in-buffer ()
- "Return a list of faces used in the current buffer.
-Under XEmacs, this returns the set of faces specified by the extents
-with the `face' property. (This covers text properties as well.) Under
-GNU Emacs, it returns the set of faces specified by the `face' text
-property and by buffer overlays that specify `face'."
- (let (faces)
- ;; Testing for (fboundp 'map-extents) doesn't work because W3
- ;; defines `map-extents' under FSF.
- (if htmlize-running-xemacs
- (let (face-prop)
- (map-extents (lambda (extent ignored)
- (setq face-prop (extent-face extent)
- ;; FACE-PROP can be a face or a list of
- ;; faces.
- faces (if (listp face-prop)
- (union face-prop faces)
- (adjoin face-prop faces)))
- nil)
- nil
- ;; Specify endpoints explicitly to respect
- ;; narrowing.
- (point-min) (point-max) nil nil 'face))
- ;; FSF Emacs code.
- ;; Faces used by text properties.
- (let ((pos (point-min)) face-prop next)
- (while (< pos (point-max))
- (setq face-prop (get-text-property pos 'face)
- next (or (next-single-property-change pos 'face) (point-max)))
- ;; FACE-PROP can be a face/attrlist or a list thereof.
- (setq faces (if (htmlize-face-list-p face-prop)
- (nunion (mapcar #'htmlize-unstringify-face face-prop)
- faces :test 'equal)
- (adjoin (htmlize-unstringify-face face-prop)
- faces :test 'equal)))
- (setq pos next)))
- ;; Faces used by overlays.
- (dolist (overlay (overlays-in (point-min) (point-max)))
- (let ((face-prop (overlay-get overlay 'face)))
- ;; FACE-PROP can be a face/attrlist or a list thereof.
- (setq faces (if (htmlize-face-list-p face-prop)
- (nunion (mapcar #'htmlize-unstringify-face face-prop)
- faces :test 'equal)
- (adjoin (htmlize-unstringify-face face-prop)
- faces :test 'equal))))))
- faces))
-
-;; htmlize-faces-at-point returns the faces in use at point. The
-;; faces are sorted by increasing priority, i.e. the last face takes
-;; precedence.
-;;
-;; Under XEmacs, this returns all the faces in all the extents at
-;; point. Under GNU Emacs, this returns all the faces in the `face'
-;; property and all the faces in the overlays at point.
-
-(cond (htmlize-running-xemacs
- (defun htmlize-faces-at-point ()
- (let (extent extent-list face-list face-prop)
- (while (setq extent (extent-at (point) nil 'face extent))
- (push extent extent-list))
- ;; extent-list is in reverse display order, meaning that
- ;; smallest ones come last. That is the order we want,
- ;; except it can be overridden by the `priority' property.
- (setq extent-list (stable-sort extent-list #'<
- :key #'extent-priority))
- (dolist (extent extent-list)
- (setq face-prop (extent-face extent))
- ;; extent's face-list is in reverse order from what we
- ;; want, but the `nreverse' below will take care of it.
- (setq face-list (if (listp face-prop)
- (append face-prop face-list)
- (cons face-prop face-list))))
- (nreverse face-list))))
- (t
- (defun htmlize-faces-at-point ()
- (let (all-faces)
- ;; Faces from text properties.
- (let ((face-prop (get-text-property (point) 'face)))
- (setq all-faces (if (htmlize-face-list-p face-prop)
- (nreverse (mapcar #'htmlize-unstringify-face
- face-prop))
- (list (htmlize-unstringify-face face-prop)))))
- ;; Faces from overlays.
- (let ((overlays
- ;; Collect overlays at point that specify `face'.
- (delete-if-not (lambda (o)
- (overlay-get o 'face))
- (overlays-at (point))))
- list face-prop)
- ;; Sort the overlays so the smaller (more specific) ones
- ;; come later. The number of overlays at each one
- ;; position should be very small, so the sort shouldn't
- ;; slow things down.
- (setq overlays (sort* overlays
- ;; Sort by ascending...
- #'<
- ;; ...overlay size.
- :key (lambda (o)
- (- (overlay-end o)
- (overlay-start o)))))
- ;; Overlay priorities, if present, override the above
- ;; established order. Larger overlay priority takes
- ;; precedence and therefore comes later in the list.
- (setq overlays (stable-sort
- overlays
- ;; Reorder (stably) by acending...
- #'<
- ;; ...overlay priority.
- :key (lambda (o)
- (or (overlay-get o 'priority) 0))))
- (dolist (overlay overlays)
- (setq face-prop (overlay-get overlay 'face))
- (setq list (if (htmlize-face-list-p face-prop)
- (nconc (nreverse (mapcar
- #'htmlize-unstringify-face
- face-prop))
- list)
- (cons (htmlize-unstringify-face face-prop) list))))
- ;; Under "Merging Faces" the manual explicitly states
- ;; that faces specified by overlays take precedence over
- ;; faces specified by text properties.
- (setq all-faces (nconc all-faces list)))
- all-faces))))
-
-;; htmlize supports generating HTML in two several fundamentally
-;; different ways, one with the use of CSS and nested <span> tags, and
-;; the other with the use of the old <font> tags. Rather than adding
-;; a bunch of ifs to many places, we take a semi-OO approach.
-;; `htmlize-buffer-1' calls a number of "methods", which indirect to
-;; the functions that depend on `htmlize-output-type'. The currently
-;; used methods are `doctype', `insert-head', `body-tag', and
-;; `insert-text'. Not all output types define all methods.
-;;
-;; Methods are called either with (htmlize-method METHOD ARGS...)
-;; special form, or by accessing the function with
-;; (htmlize-method-function 'METHOD) and calling (funcall FUNCTION).
-;; The latter form is useful in tight loops because `htmlize-method'
-;; conses.
-;;
-;; Currently defined output types are `css' and `font'.
-
-(defmacro htmlize-method (method &rest args)
- ;; Expand to (htmlize-TYPE-METHOD ...ARGS...). TYPE is the value of
- ;; `htmlize-output-type' at run time.
- `(funcall (htmlize-method-function ',method) ,@args))
-
-(defun htmlize-method-function (method)
- ;; Return METHOD's function definition for the current output type.
- ;; The returned object can be safely funcalled.
- (let ((sym (intern (format "htmlize-%s-%s" htmlize-output-type method))))
- (indirect-function (if (fboundp sym)
- sym
- (let ((default (intern (concat "htmlize-default-"
- (symbol-name method)))))
- (if (fboundp default)
- default
- 'ignore))))))
-
-(defvar htmlize-memoization-table (make-hash-table :test 'equal))
-
-(defmacro htmlize-memoize (key generator)
- "Return the value of GENERATOR, memoized as KEY.
-That means that GENERATOR will be evaluated and returned the first time
-it's called with the same value of KEY. All other times, the cached
-\(memoized) value will be returned."
- (let ((value (gensym)))
- `(let ((,value (gethash ,key htmlize-memoization-table)))
- (unless ,value
- (setq ,value ,generator)
- (setf (gethash ,key htmlize-memoization-table) ,value))
- ,value)))
-
-;;; Default methods.
-
-(defun htmlize-default-doctype ()
- nil ; no doc-string
- ;; According to DTDs published by the W3C, it is illegal to embed
- ;; <font> in <pre>. This makes sense in general, but is bad for
- ;; htmlize's intended usage of <font> to specify the document color.
-
- ;; To make generated HTML legal, htmlize's `font' mode used to
- ;; specify the SGML declaration of "HTML Pro" DTD here. HTML Pro
- ;; aka Silmaril DTD was a project whose goal was to produce a GPL'ed
- ;; DTD that would encompass all the incompatible HTML extensions
- ;; procured by Netscape, MSIE, and other players in the field.
- ;; Apparently the project got abandoned, the last available version
- ;; being "Draft 0 Revision 11" from January 1997, as documented at
- ;; <http://imbolc.ucc.ie/~pflynn/articles/htmlpro.html>.
-
- ;; Since by now HTML Pro is remembered by none but the most die-hard
- ;; early-web-days nostalgics and used by not even them, there is no
- ;; use in specifying it. So we return the standard HTML 4.0
- ;; declaration, which makes generated HTML technically illegal. If
- ;; you have a problem with that, use the `css' engine designed to
- ;; create fully conforming HTML.
-
- "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01//EN\">"
-
- ;; Now-abandoned HTML Pro declaration.
- ;"<!DOCTYPE HTML PUBLIC \"+//Silmaril//DTD HTML Pro v0r11 19970101//EN\">"
- )
-
-(defun htmlize-default-body-tag (face-map)
- nil ; no doc-string
- "<body>")
-
-;;; CSS based output support.
-
-;; Internal function; not a method.
-(defun htmlize-css-specs (fstruct)
- (let (result)
- (when (htmlize-fstruct-foreground fstruct)
- (push (format "color: %s;" (htmlize-fstruct-foreground fstruct))
- result))
- (when (htmlize-fstruct-background fstruct)
- (push (format "background-color: %s;"
- (htmlize-fstruct-background fstruct))
- result))
- (let ((size (htmlize-fstruct-size fstruct)))
- (when (and size (not (eq htmlize-ignore-face-size t)))
- (cond ((floatp size)
- (push (format "font-size: %d%%;" (* 100 size)) result))
- ((not (eq htmlize-ignore-face-size 'absolute))
- (push (format "font-size: %spt;" (/ size 10.0)) result)))))
- (when (htmlize-fstruct-boldp fstruct)
- (push "font-weight: bold;" result))
- (when (htmlize-fstruct-italicp fstruct)
- (push "font-style: italic;" result))
- (when (htmlize-fstruct-underlinep fstruct)
- (push "text-decoration: underline;" result))
- (when (htmlize-fstruct-overlinep fstruct)
- (push "text-decoration: overline;" result))
- (when (htmlize-fstruct-strikep fstruct)
- (push "text-decoration: line-through;" result))
- (nreverse result)))
-
-(defun htmlize-css-insert-head (buffer-faces face-map)
- (insert " <style type=\"text/css\">\n <!--\n")
- (insert " body {\n "
- (mapconcat #'identity
- (htmlize-css-specs (gethash 'default face-map))
- "\n ")
- "\n }\n")
- (dolist (face (sort* (copy-list buffer-faces) #'string-lessp
- :key (lambda (f)
- (htmlize-fstruct-css-name (gethash f face-map)))))
- (let* ((fstruct (gethash face face-map))
- (cleaned-up-face-name
- (let ((s
- ;; Use `prin1-to-string' rather than `symbol-name'
- ;; to get the face name because the "face" can also
- ;; be an attrlist, which is not a symbol.
- (prin1-to-string face)))
- ;; If the name contains `--' or `*/', remove them.
- (while (string-match "--" s)
- (setq s (replace-match "-" t t s)))
- (while (string-match "\\*/" s)
- (setq s (replace-match "XX" t t s)))
- s))
- (specs (htmlize-css-specs fstruct)))
- (insert " ." (htmlize-fstruct-css-name fstruct))
- (if (null specs)
- (insert " {")
- (insert " {\n /* " cleaned-up-face-name " */\n "
- (mapconcat #'identity specs "\n ")))
- (insert "\n }\n")))
- (insert htmlize-hyperlink-style
- " -->\n </style>\n"))
-
-(defun htmlize-css-insert-text (text fstruct-list buffer)
- ;; Insert TEXT colored with FACES into BUFFER. In CSS mode, this is
- ;; easy: just nest the text in one <span class=...> tag for each
- ;; face in FSTRUCT-LIST.
- (dolist (fstruct fstruct-list)
- (princ "<span class=\"" buffer)
- (princ (htmlize-fstruct-css-name fstruct) buffer)
- (princ "\">" buffer))
- (princ text buffer)
- (dolist (fstruct fstruct-list)
- (ignore fstruct) ; shut up the byte-compiler
- (princ "</span>" buffer)))
-
-;; `inline-css' output support.
-
-(defun htmlize-inline-css-body-tag (face-map)
- (format "<body style=\"%s\">"
- (mapconcat #'identity (htmlize-css-specs (gethash 'default face-map))
- " ")))
-
-(defun htmlize-inline-css-insert-text (text fstruct-list buffer)
- (let* ((merged (htmlize-merge-faces fstruct-list))
- (style (htmlize-memoize
- merged
- (let ((specs (htmlize-css-specs merged)))
- (and specs
- (mapconcat #'identity (htmlize-css-specs merged) " "))))))
- (when style
- (princ "<span style=\"" buffer)
- (princ style buffer)
- (princ "\">" buffer))
- (princ text buffer)
- (when style
- (princ "</span>" buffer))))
-
-;;; `font' tag based output support.
-
-(defun htmlize-font-body-tag (face-map)
- (let ((fstruct (gethash 'default face-map)))
- (format "<body text=\"%s\" bgcolor=\"%s\">"
- (htmlize-fstruct-foreground fstruct)
- (htmlize-fstruct-background fstruct))))
-
-(defun htmlize-font-insert-text (text fstruct-list buffer)
- ;; In `font' mode, we use the traditional HTML means of altering
- ;; presentation: <font> tag for colors, <b> for bold, <u> for
- ;; underline, and <strike> for strike-through.
- (let* ((merged (htmlize-merge-faces fstruct-list))
- (markup (htmlize-memoize
- merged
- (cons (concat
- (and (htmlize-fstruct-foreground merged)
- (format "<font color=\"%s\">" (htmlize-fstruct-foreground merged)))
- (and (htmlize-fstruct-boldp merged) "<b>")
- (and (htmlize-fstruct-italicp merged) "<i>")
- (and (htmlize-fstruct-underlinep merged) "<u>")
- (and (htmlize-fstruct-strikep merged) "<strike>"))
- (concat
- (and (htmlize-fstruct-strikep merged) "</strike>")
- (and (htmlize-fstruct-underlinep merged) "</u>")
- (and (htmlize-fstruct-italicp merged) "</i>")
- (and (htmlize-fstruct-boldp merged) "</b>")
- (and (htmlize-fstruct-foreground merged) "</font>"))))))
- (princ (car markup) buffer)
- (princ text buffer)
- (princ (cdr markup) buffer)))
-
-(defun htmlize-buffer-1 ()
- ;; Internal function; don't call it from outside this file. Htmlize
- ;; current buffer, writing the resulting HTML to a new buffer, and
- ;; return it. Unlike htmlize-buffer, this doesn't change current
- ;; buffer or use switch-to-buffer.
- (save-excursion
- ;; Protect against the hook changing the current buffer.
- (save-excursion
- (run-hooks 'htmlize-before-hook))
- ;; Convince font-lock support modes to fontify the entire buffer
- ;; in advance.
- (htmlize-ensure-fontified)
- (clrhash htmlize-extended-character-cache)
- (clrhash htmlize-memoization-table)
- (let* ((buffer-faces (htmlize-faces-in-buffer))
- (face-map (htmlize-make-face-map (adjoin 'default buffer-faces)))
- ;; Generate the new buffer. It's important that it inherits
- ;; default-directory from the current buffer.
- (htmlbuf (generate-new-buffer (if (buffer-file-name)
- (htmlize-make-file-name
- (file-name-nondirectory
- (buffer-file-name)))
- "*html*")))
- ;; Having a dummy value in the plist allows writing simply
- ;; (plist-put places foo bar).
- (places '(nil nil))
- (title (if (buffer-file-name)
- (file-name-nondirectory (buffer-file-name))
- (buffer-name))))
- ;; Initialize HTMLBUF and insert the HTML prolog.
- (with-current-buffer htmlbuf
- (buffer-disable-undo)
- (insert (htmlize-method doctype) ?\n
- (format "<!-- Created by htmlize-%s in %s mode. -->\n"
- htmlize-version htmlize-output-type)
- "<html>\n ")
- (plist-put places 'head-start (point-marker))
- (insert "<head>\n"
- " <title>" (htmlize-protect-string title) "</title>\n"
- (if htmlize-html-charset
- (format (concat " <meta http-equiv=\"Content-Type\" "
- "content=\"text/html; charset=%s\">\n")
- htmlize-html-charset)
- "")
- htmlize-head-tags)
- (htmlize-method insert-head buffer-faces face-map)
- (insert " </head>")
- (plist-put places 'head-end (point-marker))
- (insert "\n ")
- (plist-put places 'body-start (point-marker))
- (insert (htmlize-method body-tag face-map)
- "\n ")
- (plist-put places 'content-start (point-marker))
- (insert "<pre>\n"))
- (let ((insert-text-method
- ;; Get the inserter method, so we can funcall it inside
- ;; the loop. Not calling `htmlize-method' in the loop
- ;; body yields a measurable speed increase.
- (htmlize-method-function 'insert-text))
- ;; Declare variables used in loop body outside the loop
- ;; because it's faster to establish `let' bindings only
- ;; once.
- next-change text face-list fstruct-list trailing-ellipsis)
- ;; This loop traverses and reads the source buffer, appending
- ;; the resulting HTML to HTMLBUF with `princ'. This method is
- ;; fast because: 1) it doesn't require examining the text
- ;; properties char by char (htmlize-next-change is used to
- ;; move between runs with the same face), and 2) it doesn't
- ;; require buffer switches, which are slow in Emacs.
- (goto-char (point-min))
- (while (not (eobp))
- (setq next-change (htmlize-next-change (point) 'face))
- ;; Get faces in use between (point) and NEXT-CHANGE, and
- ;; convert them to fstructs.
- (setq face-list (htmlize-faces-at-point)
- fstruct-list (delq nil (mapcar (lambda (f)
- (gethash f face-map))
- face-list)))
- ;; Extract buffer text, sans the invisible parts. Then
- ;; untabify it and escape the HTML metacharacters.
- (setq text (htmlize-buffer-substring-no-invisible
- (point) next-change))
- (when trailing-ellipsis
- (setq text (htmlize-trim-ellipsis text)))
- ;; If TEXT ends up empty, don't change trailing-ellipsis.
- (when (> (length text) 0)
- (setq trailing-ellipsis
- (get-text-property (1- (length text))
- 'htmlize-ellipsis text)))
- (setq text (htmlize-untabify text (current-column)))
- (setq text (htmlize-protect-string text))
- ;; Don't bother writing anything if there's no text (this
- ;; happens in invisible regions).
- (when (> (length text) 0)
- ;; Insert the text, along with the necessary markup to
- ;; represent faces in FSTRUCT-LIST.
- (funcall insert-text-method text fstruct-list htmlbuf))
- (goto-char next-change)))
-
- ;; Insert the epilog and post-process the buffer.
- (with-current-buffer htmlbuf
- (insert "</pre>")
- (plist-put places 'content-end (point-marker))
- (insert "\n </body>")
- (plist-put places 'body-end (point-marker))
- (insert "\n</html>\n")
- (when htmlize-generate-hyperlinks
- (htmlize-make-hyperlinks))
- (htmlize-defang-local-variables)
- (when htmlize-replace-form-feeds
- ;; Change each "\n^L" to "<hr />".
- (goto-char (point-min))
- (let ((source
- ;; ^L has already been escaped, so search for that.
- (htmlize-protect-string "\n\^L"))
- (replacement
- (if (stringp htmlize-replace-form-feeds)
- htmlize-replace-form-feeds
- "</pre><hr /><pre>")))
- (while (search-forward source nil t)
- (replace-match replacement t t))))
- (goto-char (point-min))
- (when htmlize-html-major-mode
- ;; What sucks about this is that the minor modes, most notably
- ;; font-lock-mode, won't be initialized. Oh well.
- (funcall htmlize-html-major-mode))
- (set (make-local-variable 'htmlize-buffer-places) places)
- (run-hooks 'htmlize-after-hook)
- (buffer-enable-undo))
- htmlbuf)))
-
-;; Utility functions.
-
-(defmacro htmlize-with-fontify-message (&rest body)
- ;; When forcing fontification of large buffers in
- ;; htmlize-ensure-fontified, inform the user that he is waiting for
- ;; font-lock, not for htmlize to finish.
- `(progn
- (if (> (buffer-size) 65536)
- (message "Forcing fontification of %s..."
- (buffer-name (current-buffer))))
- ,@body
- (if (> (buffer-size) 65536)
- (message "Forcing fontification of %s...done"
- (buffer-name (current-buffer))))))
-
-(defun htmlize-ensure-fontified ()
- ;; If font-lock is being used, ensure that the "support" modes
- ;; actually fontify the buffer. If font-lock is not in use, we
- ;; don't care because, except in htmlize-file, we don't force
- ;; font-lock on the user.
- (when (and (boundp 'font-lock-mode)
- font-lock-mode)
- ;; In part taken from ps-print-ensure-fontified in GNU Emacs 21.
- (cond
- ((and (boundp 'jit-lock-mode)
- (symbol-value 'jit-lock-mode))
- (htmlize-with-fontify-message
- (jit-lock-fontify-now (point-min) (point-max))))
- ((and (boundp 'lazy-lock-mode)
- (symbol-value 'lazy-lock-mode))
- (htmlize-with-fontify-message
- (lazy-lock-fontify-region (point-min) (point-max))))
- ((and (boundp 'lazy-shot-mode)
- (symbol-value 'lazy-shot-mode))
- (htmlize-with-fontify-message
- ;; lazy-shot is amazing in that it must *refontify* the region,
- ;; even if the whole buffer has already been fontified. <sigh>
- (lazy-shot-fontify-region (point-min) (point-max))))
- ;; There's also fast-lock, but we don't need to handle specially,
- ;; I think. fast-lock doesn't really defer fontification, it
- ;; just saves it to an external cache so it's not done twice.
- )))
-
-
-;;;###autoload
-(defun htmlize-buffer (&optional buffer)
- "Convert BUFFER to HTML, preserving colors and decorations.
-
-The generated HTML is available in a new buffer, which is returned.
-When invoked interactively, the new buffer is selected in the current
-window. The title of the generated document will be set to the buffer's
-file name or, if that's not available, to the buffer's name.
-
-Note that htmlize doesn't fontify your buffers, it only uses the
-decorations that are already present. If you don't set up font-lock or
-something else to fontify your buffers, the resulting HTML will be
-plain. Likewise, if you don't like the choice of colors, fix the mode
-that created them, or simply alter the faces it uses."
- (interactive)
- (let ((htmlbuf (with-current-buffer (or buffer (current-buffer))
- (htmlize-buffer-1))))
- (when (interactive-p)
- (switch-to-buffer htmlbuf))
- htmlbuf))
-
-;;;###autoload
-(defun htmlize-region (beg end)
- "Convert the region to HTML, preserving colors and decorations.
-See `htmlize-buffer' for details."
- (interactive "r")
- ;; Don't let zmacs region highlighting end up in HTML.
- (when (fboundp 'zmacs-deactivate-region)
- (zmacs-deactivate-region))
- (let ((htmlbuf (save-restriction
- (narrow-to-region beg end)
- (htmlize-buffer-1))))
- (when (interactive-p)
- (switch-to-buffer htmlbuf))
- htmlbuf))
-
-(defun htmlize-region-for-paste (beg end)
- "Htmlize the region and return just the HTML as a string.
-This forces the `inline-css' style and only returns the HTML body,
-but without the BODY tag. This should make it useful for inserting
-the text to another HTML buffer."
- (let* ((htmlize-output-type 'inline-css)
- (htmlbuf (htmlize-region beg end)))
- (unwind-protect
- (with-current-buffer htmlbuf
- (buffer-substring (plist-get htmlize-buffer-places 'content-start)
- (plist-get htmlize-buffer-places 'content-end)))
- (kill-buffer htmlbuf))))
-
-(defun htmlize-make-file-name (file)
- "Make an HTML file name from FILE.
-
-In its default implementation, this simply appends `.html' to FILE.
-This function is called by htmlize to create the buffer file name, and
-by `htmlize-file' to create the target file name.
-
-More elaborate transformations are conceivable, such as changing FILE's
-extension to `.html' (\"file.c\" -> \"file.html\"). If you want them,
-overload this function to do it and htmlize will comply."
- (concat file ".html"))
-
-;; Older implementation of htmlize-make-file-name that changes FILE's
-;; extension to ".html".
-;(defun htmlize-make-file-name (file)
-; (let ((extension (file-name-extension file))
-; (sans-extension (file-name-sans-extension file)))
-; (if (or (equal extension "html")
-; (equal extension "htm")
-; (equal sans-extension ""))
-; (concat file ".html")
-; (concat sans-extension ".html"))))
-
-;;;###autoload
-(defun htmlize-file (file &optional target)
- "Load FILE, fontify it, convert it to HTML, and save the result.
-
-Contents of FILE are inserted into a temporary buffer, whose major mode
-is set with `normal-mode' as appropriate for the file type. The buffer
-is subsequently fontified with `font-lock' and converted to HTML. Note
-that, unlike `htmlize-buffer', this function explicitly turns on
-font-lock. If a form of highlighting other than font-lock is desired,
-please use `htmlize-buffer' directly on buffers so highlighted.
-
-Buffers currently visiting FILE are unaffected by this function. The
-function does not change current buffer or move the point.
-
-If TARGET is specified and names a directory, the resulting file will be
-saved there instead of to FILE's directory. If TARGET is specified and
-does not name a directory, it will be used as output file name."
- (interactive (list (read-file-name
- "HTML-ize file: "
- nil nil nil (and (buffer-file-name)
- (file-name-nondirectory
- (buffer-file-name))))))
- (let ((output-file (if (and target (not (file-directory-p target)))
- target
- (expand-file-name
- (htmlize-make-file-name (file-name-nondirectory file))
- (or target (file-name-directory file)))))
- ;; Try to prevent `find-file-noselect' from triggering
- ;; font-lock because we'll fontify explicitly below.
- (font-lock-mode nil)
- (font-lock-auto-fontify nil)
- (global-font-lock-mode nil)
- ;; Ignore the size limit for the purposes of htmlization.
- (font-lock-maximum-size nil)
- ;; Disable font-lock support modes. This will only work in
- ;; more recent Emacs versions, so htmlize-buffer-1 still needs
- ;; to call htmlize-ensure-fontified.
- (font-lock-support-mode nil))
- (with-temp-buffer
- ;; Insert FILE into the temporary buffer.
- (insert-file-contents file)
- ;; Set the file name so normal-mode and htmlize-buffer-1 pick it
- ;; up. Restore it afterwards so with-temp-buffer's kill-buffer
- ;; doesn't complain about killing a modified buffer.
- (let ((buffer-file-name file))
- ;; Set the major mode for the sake of font-lock.
- (normal-mode)
- (font-lock-mode 1)
- (unless font-lock-mode
- ;; In GNU Emacs (font-lock-mode 1) doesn't force font-lock,
- ;; contrary to the documentation. This seems to work.
- (font-lock-fontify-buffer))
- ;; htmlize the buffer and save the HTML.
- (with-current-buffer (htmlize-buffer-1)
- (unwind-protect
- (progn
- (run-hooks 'htmlize-file-hook)
- (write-region (point-min) (point-max) output-file))
- (kill-buffer (current-buffer)))))))
- ;; I haven't decided on a useful return value yet, so just return
- ;; nil.
- nil)
-
-;;;###autoload
-(defun htmlize-many-files (files &optional target-directory)
- "Convert FILES to HTML and save the corresponding HTML versions.
-
-FILES should be a list of file names to convert. This function calls
-`htmlize-file' on each file; see that function for details. When
-invoked interactively, you are prompted for a list of files to convert,
-terminated with RET.
-
-If TARGET-DIRECTORY is specified, the HTML files will be saved to that
-directory. Normally, each HTML file is saved to the directory of the
-corresponding source file."
- (interactive
- (list
- (let (list file)
- ;; Use empty string as DEFAULT because setting DEFAULT to nil
- ;; defaults to the directory name, which is not what we want.
- (while (not (equal (setq file (read-file-name
- "HTML-ize file (RET to finish): "
- (and list (file-name-directory
- (car list)))
- "" t))
- ""))
- (push file list))
- (nreverse list))))
- ;; Verify that TARGET-DIRECTORY is indeed a directory. If it's a
- ;; file, htmlize-file will use it as target, and that doesn't make
- ;; sense.
- (and target-directory
- (not (file-directory-p target-directory))
- (error "target-directory must name a directory: %s" target-directory))
- (dolist (file files)
- (htmlize-file file target-directory)))
-
-;;;###autoload
-(defun htmlize-many-files-dired (arg &optional target-directory)
- "HTMLize dired-marked files."
- (interactive "P")
- (htmlize-many-files (dired-get-marked-files nil arg) target-directory))
-
-(provide 'htmlize)
-
-;;; htmlize.el ends here
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-annotate-file.el b/.emacs.d/org-7.4/contrib/lisp/org-annotate-file.el
deleted file mode 100644
index 9ea9015..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-annotate-file.el
+++ /dev/null
@@ -1,130 +0,0 @@
-;;; org-annotate-file.el --- Annotate a file with org syntax
-
-;; Copyright (C) 2008 Philip Jackson
-
-;; Author: Philip Jackson <phil@shellarchive.co.uk>
-;; Version: 0.2
-
-;; This file is not currently part of GNU Emacs.
-
-;; 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 ; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This is yet another implementation to allow the annotation of a
-;; file without modification of the file itself. The annotation is in
-;; org syntax so you can use all of the org features you are used to.
-
-;; To use you might put the following in your .emacs:
-;;
-;; (require 'org-annotate-file)
-;; (global-set-key (kbd "C-c C-l") 'org-annotate-file) ; for example
-;;
-;; To change the location of the annotation file:
-;;
-;; (setq org-annotate-file-storage-file "~/annotated.org")
-;;
-;; Then when you visit any file and hit C-c C-l you will find yourself
-;; in an org buffer on a headline which links to the file you were
-;; visiting, e.g:
-
-;; * ~/org-annotate-file.el
-
-;; Under here you can put anything you like, save the file
-;; and next time you hit C-c C-l you will hit those notes again.
-;;
-;; To put a subheading with a text search for the current line set
-;; `org-annotate-file-add-search` to non-nil value. Then when you hit
-;; C-c C-l (on the above line for example) you will get:
-
-;; * ~/org-annotate-file.el
-;; ** `org-annotate-file-add-search` to non-nil value. Then whe...
-
-;; Note that both of the above will be links.
-
-(require 'org)
-
-(defvar org-annotate-file-storage-file "~/.org-annotate-file.org"
- "File in which to keep annotations.")
-
-(defvar org-annotate-file-add-search nil
- "If non-nil then add a link as a second level to the actual
-location in the file")
-
-(defvar org-annotate-file-always-open t
- "non-nil means always expand the full tree when you visit
-`org-annotate-file-storage-file'.")
-
-(defun org-annotate-file-elipsify-desc (string &optional after)
- "Strip starting and ending whitespace and replace any chars
-that appear after the value in `after' with '...'"
- (let* ((after (number-to-string (or after 30)))
- (replace-map (list (cons "^[ \t]*" "")
- (cons "[ \t]*$" "")
- (cons (concat "^\\(.\\{" after
- "\\}\\).*") "\\1..."))))
- (mapc (lambda (x)
- (when (string-match (car x) string)
- (setq string (replace-match (cdr x) nil nil string))))
- replace-map)
- string))
-
-(defun org-annotate-file ()
- "Put a section for the current file into your annotation file"
- (interactive)
- (unless (buffer-file-name)
- (error "This buffer has no associated file."))
- (org-annotate-file-show-section))
-
-(defun org-annotate-file-show-section (&optional buffer)
- "Visit the buffer named `org-annotate-file-storage-file' and
-show the relevant section"
- (let* ((filename (abbreviate-file-name (or buffer (buffer-file-name))))
- (line (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
- (link (org-make-link-string (concat "file:" filename) filename))
- (search-link (org-make-link-string
- (concat "file:" filename "::" line)
- (org-annotate-file-elipsify-desc line))))
- (with-current-buffer (find-file org-annotate-file-storage-file)
- (unless (org-mode-p)
- (org-mode))
- (goto-char (point-min))
- (widen)
- (when org-annotate-file-always-open
- (show-all))
- (unless (search-forward-regexp
- (concat "^* " (regexp-quote link)) nil t)
- (org-annotate-file-add-upper-level link))
- (beginning-of-line)
- (org-narrow-to-subtree)
- ;; deal with a '::' search if need be
- (when org-annotate-file-add-search
- (unless (search-forward-regexp
- (concat "^** " (regexp-quote search-link)) nil t)
- (org-annotate-file-add-second-level search-link))))))
-
-(defun org-annotate-file-add-upper-level (link)
- (goto-char (point-min))
- (call-interactively 'org-insert-heading)
- (insert link))
-
-(defun org-annotate-file-add-second-level (link)
- (goto-char (point-at-eol))
- (call-interactively 'org-insert-subheading)
- (insert link))
-
-(provide 'org-annotate-file)
-;;; org-annotate-file.el ends here
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-bookmark.el b/.emacs.d/org-7.4/contrib/lisp/org-bookmark.el
deleted file mode 100644
index 06d2c60..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-bookmark.el
+++ /dev/null
@@ -1,88 +0,0 @@
-;;; org-bookmark.el - Support for links to bookmark
-;; Copyright (C) 2008 Free Software Foundation, Inc.
-;;
-;; Author: Tokuya Kameshima <kames AT fa2.so-net.ne.jp>
-;; Version: 1.0
-;; Keywords: outlines, hypermedia, calendar, wp
-;;
-;; This file is not part of GNU Emacs.
-;;
-;; 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, 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; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(require 'org)
-(require 'bookmark)
-
-(defgroup org-bookmark nil
- "Options concerning the bookmark link."
- :tag "Org Startup"
- :group 'org-link)
-
-(defcustom org-bookmark-in-dired nil
- "Use org-bookmark in dired."
- :group 'org-bookmark
- :type 'boolean)
-
-(defcustom org-bookmark-when-visiting-a-file nil
- "Use org-bookmark in any buffer visiting a file."
- :group 'org-bookmark
- :type 'boolean)
-
-(defcustom org-bookmark-use-first-bookmark nil
- "If several bookmarks links to the buffer, take the first one.
-Otherwise prompt the user for the right bookmark to use."
- :group 'org-bookmark
- :type 'boolean)
-
-(org-add-link-type "bookmark" 'org-bookmark-open)
-(add-hook 'org-store-link-functions 'org-bookmark-store-link)
-
-(defun org-bookmark-open (bookmark)
- "Visit the bookmark BOOKMARK."
- (bookmark-jump bookmark))
-
-(defun org-bookmark-store-link ()
- "Store a link to the current line's bookmark in bookmark list."
- (let (file bookmark bmks)
- (cond ((and org-bookmark-in-dired
- (eq major-mode 'dired-mode))
- (setq file (abbreviate-file-name (dired-get-filename))))
- ((and org-bookmark-when-visiting-a-file
- (buffer-file-name (buffer-base-buffer)))
- (setq file (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer))))))
- (if (not file)
- (when (eq major-mode 'bookmark-bmenu-mode)
- (setq bookmark (bookmark-bmenu-bookmark)))
- (when (and (setq bmks
- (mapcar (lambda (name)
- (if (equal file
- (abbreviate-file-name
- (bookmark-location name)))
- name))
- (bookmark-all-names)))
- (setq bmks (delete nil bmks)))
- (setq bookmark
- (if (or (eq 1 (length bmks)) org-bookmark-use-first-bookmark)
- (car bmks)
- (completing-read "Bookmark: " bmks nil t nil nil (car bmks))))))
- (if bookmark
- (org-store-link-props :link (org-make-link "bookmark:" bookmark)
- :description bookmark))))
-
-(provide 'org-bookmark)
-
-;;; org-bookmark.el ends here
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-checklist.el b/.emacs.d/org-7.4/contrib/lisp/org-checklist.el
deleted file mode 100644
index 50df757..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-checklist.el
+++ /dev/null
@@ -1,143 +0,0 @@
-;;; org-checklist.el --- org functions for checklist handling
-
-;; Copyright (C) 2008 James TD Smith
-
-;; Author: James TD Smith (@ ahktenzero (. mohorovi cc))
-;; Version: 1.0
-;; Keywords: org, checklists
-;;
-;; 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 3, 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, write to the Free Software
-;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; This file provides some functions for handing repeated tasks which involve
-;; checking off a list of items. By setting the RESET_CHECK_BOXES property in an
-;; item, when the TODO state is set to done all checkboxes under that item are
-;; cleared. If the LIST_EXPORT_BASENAME property is set, a file will be created
-;; using the value of that property plus a timestamp, containing all the items
-;; in the list which are not checked. Additionally the user will be prompted to
-;; print the list.
-;;
-;; I use this for to keep track of stores of various things (food stores,
-;; components etc) which I check periodically and use the exported list of items
-;; which are not present as a shopping list.
-;;
-;;; Usage:
-;; (require 'org-checklist)
-;;
-;; Set the RESET_CHECK_BOXES and LIST_EXPORT_BASENAME properties in items as
-;; needed.
-;;
-;;; Code:
-(require 'org)
-(load "a2ps-print" 'no-error)
-
-(setq org-default-properties (cons "RESET_CHECK_BOXES" (cons "LIST_EXPORT_BASENAME" org-default-properties)))
-
-(defgroup org-checklist nil
- "Extended checklist handling for org"
- :tag "Org-checklist"
- :group 'org)
-
-(defcustom org-checklist-export-time-format "%Y%m%d%H%M"
- "The format of timestamp appended to LIST_EXPORT_BASENAME to
- make the name of the export file."
- :link '(function-link format-time-string)
- :group 'org-checklist
- :type 'string)
-
-(defcustom org-checklist-export-function 'org-export-as-ascii
- "function used to prepare the export file for printing"
- :group 'org-checklist
- :type '(radio (function-item :tag "ascii text" org-export-as-ascii)
- (function-item :tag "HTML" org-export-as-html)
- (function-item :tag "LaTeX" :value org-export-as-latex)
- (function-item :tag "XOXO" :value org-export-as-xoxo)))
-
-(defcustom org-checklist-export-params nil
- "options for the export function file for printing"
- :group 'org-checklist
- :type '(repeat string))
-
-(defcustom org-checklist-a2ps-params nil
- "options for a2ps for printing"
- :group 'org-checklist
- :type '(repeat string))
-
-(defun org-reset-checkbox-state-maybe ()
- "Reset all checkboxes in an entry if the `RESET_CHECK_BOXES' property is set"
- (interactive "*")
- (if (org-entry-get (point) "RESET_CHECK_BOXES")
- (org-reset-checkbox-state-subtree)))
-
-
-(defun org-make-checklist-export ()
- "Produce a checklist containing all unchecked items from a list
-of checkbox items"
- (interactive "*")
- (if (org-entry-get (point) "LIST_EXPORT_BASENAME")
- (let* ((export-file (concat (org-entry-get (point) "LIST_EXPORT_BASENAME" nil)
- "-" (format-time-string
- org-checklist-export-time-format)
- ".org"))
- (print (case (org-entry-get (point) "PRINT_EXPORT" nil)
- (("" "nil" nil) nil)
- (t t)
- (nil (y-or-n-p "Print list? "))))
- exported-lines
- (title "Checklist export"))
- (save-restriction
- (save-excursion
- (org-narrow-to-subtree)
- (org-update-checkbox-count-maybe)
- (org-show-subtree)
- (goto-char (point-min))
- (when (looking-at org-complex-heading-regexp)
- (setq title (match-string 4)))
- (goto-char (point-min))
- (let ((end (point-max)))
- (while (< (point) end)
- (when (and (org-at-item-checkbox-p)
- (or (string= (match-string 0) "[ ]")
- (string= (match-string 0) "[-]")))
- (add-to-list 'exported-lines (thing-at-point 'line) t))
- (beginning-of-line 2)))
- (set-buffer (get-buffer-create export-file))
- (org-insert-heading)
- (insert (or title export-file) "\n")
- (dolist (entry exported-lines) (insert entry))
- (org-update-checkbox-count-maybe)
- (write-file export-file)
- (if (print)
- (progn (funcall org-checklist-export-function
- org-checklist-export-params)
- (let* ((current-a2ps-switches a2ps-switches)
- (a2ps-switches (append current-a2ps-switches
- org-checklist-a2ps-params)))
- (a2ps-buffer)))))))))
-
-(defun org-checklist ()
- (when (member state org-done-keywords)
- (org-make-checklist-export)
- (org-reset-checkbox-state-maybe)))
-
-(add-hook 'org-after-todo-state-change-hook 'org-checklist)
-
-(provide 'org-checklist)
-
-;;; org-checklist.el ends here
-
-
-
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-choose.el b/.emacs.d/org-7.4/contrib/lisp/org-choose.el
deleted file mode 100644
index 6f7f120..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-choose.el
+++ /dev/null
@@ -1,539 +0,0 @@
-;;;_ org-choose.el --- decision management for org-mode
-
-;;;_. Headers
-;;;_ , License
-;; Copyright (C) 2009 Tom Breton (Tehom)
-
-;; Author: Tom Breton (Tehom)
-;; Keywords: outlines, convenience
-
-;; This file 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 file 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; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;;_ , Commentary:
-
-; This is code to support decision management. It lets you treat a
-; group of sibling items in org-mode as alternatives in a decision.
-
-; There are no user commands in this file. You use it by:
-; * Loading it (manually or by M-x customize-apropos org-modules)
-
-;; * Setting up at least one set of TODO keywords with the
-;; interpretation "choose" by either:
-
-;; * Using the file directive #+CHOOSE_TODO:
-
-;; * For instance, "#+CHOOSE_TODO: NO(,-) MAYBE(,0) YES"
-
-;; * Or by M-x customize-apropos org-todo-keywords
-
-;; * Operating on single items with the TODO commands.
-
-;; * Use C-S-right to change the keyword set. Use this to change to
-;; the "choose" keyword set that you just defined.
-
-;; * Use S-right to advance the TODO mark to the next setting.
-
-;; For "choose", that means you like this alternative more than
-;; before. Other alternatives will be automatically demoted to
-;; keep your settings consistent.
-
-;; * Use S-left to demote TODO to the previous setting.
-
-;; For "choose", that means you don't like this alternative as much
-;; as before. Other alternatives will be automatically promoted,
-;; if this item was all that was keeping them down.
-
-;; * All the other TODO commands are available and behave essentially
-;; the normal way.
-
-
-;;;_ , Requires
-
-(require 'org)
-;(eval-when-compile
-; (require 'cl))
-(require 'cl)
-
-;;;_. Body
-;;;_ , The variables
-
-(defstruct (org-choose-mark-data. (:type list))
- "The format of an entry in org-choose-mark-data.
-Indexes are 0-based or `nil'.
-"
- keyword
- bot-lower-range
- top-upper-range
- range-length
- static-default
- all-keywords)
-
-(defvar org-choose-mark-data
- ()
- "Alist of information for choose marks.
-
-Each entry is an `org-choose-mark-data.'" )
-(make-variable-buffer-local 'org-choose-mark-data)
-;;;_ , For setup
-;;;_ . org-choose-filter-one
-
-(defun org-choose-filter-one (i)
- "Return a list of
- * a canonized version of the string
- * optionally one symbol"
-
- (if
- (not
- (string-match "(.*)" i))
- (list i i)
- (let*
- (
- (end-text (match-beginning 0))
- (vanilla-text (substring i 0 end-text))
- ;;Get the parenthesized part.
- (match (match-string 0 i))
- ;;Remove the parentheses.
- (args (substring match 1 -1))
- ;;Split it
- (arglist
- (let
- ((arglist-x (org-split-string args ",")))
- ;;When string starts with "," `split-string' doesn't
- ;;make a first arg, so in that case make one
- ;;manually.
- (if
- (string-match "^," args)
- (cons nil arglist-x)
- arglist-x)))
- (decision-arg (second arglist))
- (type
- (cond
- ((string= decision-arg "0")
- 'default-mark)
- ((string= decision-arg "+")
- 'top-upper-range)
- ((string= decision-arg "-")
- 'bot-lower-range)
- (t nil)))
- (vanilla-arg (first arglist))
- (vanilla-mark
- (if vanilla-arg
- (concat vanilla-text "("vanilla-arg")")
- vanilla-text)))
- (if type
- (list vanilla-text vanilla-mark type)
- (list vanilla-text vanilla-mark)))))
-
-;;;_ . org-choose-setup-vars
-(defun org-choose-setup-vars (bot-lower-range top-upper-range
- static-default num-items all-mark-texts)
- "Add to org-choose-mark-data according to arguments"
-
- (let*
- (
- (tail
- ;;If there's no bot-lower-range or no default, we don't
- ;;have ranges.
- (cdr
- (if (and static-default bot-lower-range)
- (let*
- (
- ;;If there's no top-upper-range, use the last
- ;;item.
- (top-upper-range
- (or top-upper-range (1- num-items)))
- (lower-range-length
- (1+ (- static-default bot-lower-range)))
- (upper-range-length
- (- top-upper-range static-default))
- (range-length
- (min upper-range-length lower-range-length)))
-
-
- (make-org-choose-mark-data.
- :keyword nil
- :bot-lower-range bot-lower-range
- :top-upper-range top-upper-range
- :range-length range-length
- :static-default static-default
- :all-keywords all-mark-texts))
-
- (make-org-choose-mark-data.
- :keyword nil
- :bot-lower-range nil
- :top-upper-range nil
- :range-length nil
- :static-default (or static-default 0)
- :all-keywords all-mark-texts)))))
-
- (dolist (text all-mark-texts)
- (pushnew (cons text tail)
- org-choose-mark-data
- :test
- #'(lambda (a b)
- (equal (car a) (car b)))))))
-
-
-
-
-;;;_ . org-choose-filter-tail
-(defun org-choose-filter-tail (raw)
- "Return a translation of RAW to vanilla and set appropriate
-buffer-local variables.
-
-RAW is a list of strings representing the input text of a choose
-interpretation."
- (let
- ((vanilla-list nil)
- (all-mark-texts nil)
- (index 0)
- bot-lower-range top-upper-range range-length static-default)
- (dolist (i raw)
- (destructuring-bind
- (vanilla-text vanilla-mark &optional type)
- (org-choose-filter-one i)
- (cond
- ((eq type 'bot-lower-range)
- (setq bot-lower-range index))
- ((eq type 'top-upper-range)
- (setq top-upper-range index))
- ((eq type 'default-mark)
- (setq static-default index)))
- (incf index)
- (push vanilla-text all-mark-texts)
- (push vanilla-mark vanilla-list)))
-
- (org-choose-setup-vars bot-lower-range top-upper-range
- static-default index (reverse all-mark-texts))
- (nreverse vanilla-list)))
-
-;;;_ . org-choose-setup-filter
-
-(defun org-choose-setup-filter (raw)
- "A setup filter for choose interpretations."
- (when (eq (car raw) 'choose)
- (cons
- 'choose
- (org-choose-filter-tail (cdr raw)))))
-
-;;;_ . org-choose-conform-after-promotion
-(defun org-choose-conform-after-promotion (entry-pos keywords highest-ok-ix)
- "Conform the current item after another item was promoted"
-
- (unless
- ;;Skip the entry that triggered this by skipping any entry with
- ;;the same starting position. plist uses the start of the
- ;;header line as the position, but map no longer does, so we
- ;;have to go back to the heading.
- (=
- (save-excursion
- (org-back-to-heading)
- (point))
- entry-pos)
- (let
- ((ix
- (org-choose-get-entry-index keywords)))
- ;;If the index of the entry exceeds the highest allowable
- ;;index, change it to that.
- (when (and ix
- (> ix highest-ok-ix))
- (org-todo
- (nth highest-ok-ix keywords))))))
-;;;_ . org-choose-conform-after-demotion
-(defun org-choose-conform-after-demotion (entry-pos keywords
- raise-to-ix
- old-highest-ok-ix)
- "Conform the current item after another item was demoted."
-
- (unless
- ;;Skip the entry that triggered this.
- (=
- (save-excursion
- (org-back-to-heading)
- (point))
- entry-pos)
- (let
- ((ix
- (org-choose-get-entry-index keywords)))
- ;;If the index of the entry was at or above the old allowable
- ;;position, change it to the new mirror position if there is
- ;;one.
- (when (and
- ix
- raise-to-ix
- (>= ix old-highest-ok-ix))
- (org-todo
- (nth raise-to-ix keywords))))))
-
-;;;_ , org-choose-keep-sensible (the org-trigger-hook function)
-(defun org-choose-keep-sensible (change-plist)
- "Bring the other items back into a sensible state after an item's
-setting was changed."
- (let*
- ( (from (plist-get change-plist :from))
- (to (plist-get change-plist :to))
- (entry-pos
- (set-marker
- (make-marker)
- (plist-get change-plist :position)))
- (kwd-data
- (assoc to org-todo-kwd-alist)))
- (when
- (eq (nth 1 kwd-data) 'choose)
- (let*
- (
- (data
- (assoc to org-choose-mark-data))
- (keywords
- (org-choose-mark-data.-all-keywords data))
- (old-index
- (org-choose-get-index-in-keywords
- from
- keywords))
- (new-index
- (org-choose-get-index-in-keywords
- to
- keywords))
- (highest-ok-ix
- (org-choose-highest-other-ok
- new-index
- data))
- (funcdata
- (cond
- ;;The entry doesn't participate in conformance,
- ;;so give `nil' which does nothing.
- ((not highest-ok-ix) nil)
- ;;The entry was created or promoted
- ((or
- (not old-index)
- (> new-index old-index))
- (list
- #'org-choose-conform-after-promotion
- entry-pos keywords
- highest-ok-ix))
- (t ;;Otherwise the entry was demoted.
- (let
- (
- (raise-to-ix
- (min
- highest-ok-ix
- (org-choose-mark-data.-static-default
- data)))
- (old-highest-ok-ix
- (org-choose-highest-other-ok
- old-index
- data)))
-
- (list
- #'org-choose-conform-after-demotion
- entry-pos
- keywords
- raise-to-ix
- old-highest-ok-ix))))))
-
- (if funcdata
- ;;The funny-looking names are to make variable capture
- ;;unlikely. (Poor-man's lexical bindings).
- (destructuring-bind (func-d473 . args-46k) funcdata
- (let
- ((map-over-entries
- (org-choose-get-fn-map-group))
- ;;We may call `org-todo', so let various hooks
- ;;`nil' so we don't cause loops.
- org-after-todo-state-change-hook
- org-trigger-hook
- org-blocker-hook
- org-todo-get-default-hook
- ;;Also let this alist `nil' so we don't log
- ;;secondary transitions.
- org-todo-log-states)
- ;;Map over group
- (funcall map-over-entries
- #'(lambda ()
- (apply func-d473 args-46k))))))))
-
- ;;Remove the marker
- (set-marker entry-pos nil)))
-
-
-
-;;;_ , Getting the default mark
-;;;_ . org-choose-get-index-in-keywords
-(defun org-choose-get-index-in-keywords (ix all-keywords)
- "Return the index of the current entry."
-
- (if ix
- (position ix all-keywords
- :test #'equal)))
-
-;;;_ . org-choose-get-entry-index
-(defun org-choose-get-entry-index (all-keywords)
- "Return index of current entry."
-
- (let*
- ((state (org-entry-get (point) "TODO")))
- (org-choose-get-index-in-keywords state all-keywords)))
-
-;;;_ . org-choose-get-fn-map-group
-
-(defun org-choose-get-fn-map-group ()
- "Return a function to map over the group"
-
- #'(lambda (fn)
- (require 'org-agenda) ;; `org-map-entries' seems to need it.
- (save-excursion
- (unless (org-up-heading-safe)
- (error "Choosing is only supported between siblings in a tree, not on top level"))
- (let
- ((level (org-reduced-level (org-outline-level))))
- (save-restriction
- (org-map-entries
- fn
- (format "LEVEL=%d" level)
- 'tree))))))
-
-;;;_ . org-choose-get-highest-mark-index
-
-(defun org-choose-get-highest-mark-index (keywords)
- "Get the index of the highest current mark in the group.
-If there is none, return 0"
-
- (let*
- (
- ;;Func maps over applicable entries.
- (map-over-entries
- (org-choose-get-fn-map-group))
-
- (indexes-list
- (remove nil
- (funcall map-over-entries
- #'(lambda ()
- (org-choose-get-entry-index keywords))))))
- (if
- indexes-list
- (apply #'max indexes-list)
- 0)))
-
-
-;;;_ . org-choose-highest-ok
-
-(defun org-choose-highest-other-ok (ix data)
- "Return the highest index that any choose mark can sensibly have,
-given that another mark has index IX.
-DATA must be a `org-choose-mark-data.'."
-
- (let
- (
- (bot-lower-range
- (org-choose-mark-data.-bot-lower-range data))
- (top-upper-range
- (org-choose-mark-data.-top-upper-range data))
- (range-length
- (org-choose-mark-data.-range-length data)))
- (when (and ix bot-lower-range)
- (let*
- ((delta
- (- top-upper-range ix)))
- (unless
- (< range-length delta)
- (+ bot-lower-range delta))))))
-
-;;;_ . org-choose-get-default-mark-index
-
-(defun org-choose-get-default-mark-index (data)
- "Return the index of the default mark in a choose interpretation.
-
-DATA must be a `org-choose-mark-data.'."
-
-
- (or
- (let
- ((highest-mark-index
- (org-choose-get-highest-mark-index
- (org-choose-mark-data.-all-keywords data))))
- (org-choose-highest-other-ok
- highest-mark-index data))
- (org-choose-mark-data.-static-default data)))
-
-
-
-;;;_ . org-choose-get-mark-N
-(defun org-choose-get-mark-N (n data)
- "Get the text of the nth mark in a choose interpretation."
-
- (let*
- ((l (org-choose-mark-data.-all-keywords data)))
- (nth n l)))
-
-;;;_ . org-choose-get-default-mark
-
-(defun org-choose-get-default-mark (new-mark old-mark)
- "Get the default mark IFF in a choose interpretation.
-NEW-MARK and OLD-MARK are the text of the new and old marks."
-
- (let*
- (
- (old-kwd-data
- (assoc old-mark org-todo-kwd-alist))
- (new-kwd-data
- (assoc new-mark org-todo-kwd-alist))
- (becomes-choose
- (and
- (or
- (not old-kwd-data)
- (not
- (eq (nth 1 old-kwd-data) 'choose)))
- (eq (nth 1 new-kwd-data) 'choose))))
- (when
- becomes-choose
- (let
- ((new-mark-data
- (assoc new-mark org-choose-mark-data)))
- (if
- new-mark
- (org-choose-get-mark-N
- (org-choose-get-default-mark-index
- new-mark-data)
- new-mark-data)
- (error "Somehow got an unrecognizable mark"))))))
-
-;;;_ , Setting it all up
-
-(eval-after-load "org"
- '(progn
- (add-to-list 'org-todo-setup-filter-hook
- #'org-choose-setup-filter)
- (add-to-list 'org-todo-get-default-hook
- #'org-choose-get-default-mark)
- (add-to-list 'org-trigger-hook
- #'org-choose-keep-sensible)
- (add-to-list 'org-todo-interpretation-widgets
- '(:tag "Choose (to record decisions)" choose)
- 'append)
- ))
-
-
-;;;_. Footers
-;;;_ , Provides
-
-(provide 'org-choose)
-
-;;;_ * Local emacs vars.
-;;;_ + Local variables:
-;;;_ + End:
-
-;;;_ , End
-;;; org-choose.el ends here
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-collector.el b/.emacs.d/org-7.4/contrib/lisp/org-collector.el
deleted file mode 100644
index 1d4f042..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-collector.el
+++ /dev/null
@@ -1,235 +0,0 @@
-;;; org-collector --- collect properties into tables
-
-;; Copyright (C) 2008 Free Software Foundation, Inc.
-
-;; Author: Eric Schulte <schulte dot eric at gmail dot com>
-;; Keywords: outlines, hypermedia, calendar, wp, experimentation,
-;; organization, properties
-;; Homepage: http://orgmode.org
-;; Version: 0.01
-
-;; This file is not yet 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, 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:
-
-;; Pass in an alist of columns, each column can be either a single
-;; property or a function which takes column names as arguments.
-;;
-;; For example the following propview block would collect the value of
-;; the 'amount' property from each header in the current buffer
-;;
-;; #+BEGIN: propview :cols (ITEM amount)
-;; | "ITEM" | "amount" |
-;; |---------------------+----------|
-;; | "December Spending" | 0 |
-;; | "Grocery Store" | 56.77 |
-;; | "Athletic club" | 75.0 |
-;; | "Restaurant" | 30.67 |
-;; | "January Spending" | 0 |
-;; | "Athletic club" | 75.0 |
-;; | "Restaurant" | 50.00 |
-;; |---------------------+----------|
-;; | | |
-;; #+END:
-;;
-;; This slightly more selective propview block will limit those
-;; headers included to those in the subtree with the id 'december'
-;; in which the spendtype property is equal to "food"
-;;
-;; #+BEGIN: propview :id "december" :conds ((string= spendtype "food")) :cols (ITEM amount)
-;; | "ITEM" | "amount" |
-;; |-----------------+----------|
-;; | "Grocery Store" | 56.77 |
-;; | "Restaurant" | 30.67 |
-;; |-----------------+----------|
-;; | | |
-;; #+END:
-;;
-;; Org Collector allows arbitrary processing of the property values
-;; through elisp in the cols: property. This allows for both simple
-;; computations as in the following example
-;;
-;; #+BEGIN: propview :id "results" :cols (ITEM f d list (apply '+ list) (+ f d))
-;; | "ITEM" | "f" | "d" | "list" | "(apply (quote +) list)" | "(+ f d)" |
-;; |--------+-----+-----+-------------------------+--------------------------+-----------|
-;; | "run1" | 2 | 33 | (quote (9 2 3 4 5 6 7)) | 36 | 35 |
-;; | "run2" | 2 | 34 | :na | :na | 36 |
-;; | "run3" | 2 | 35 | :na | :na | 37 |
-;; | "run4" | 2 | 36 | :na | :na | 38 |
-;; | | | | | | |
-;; #+END:
-;;
-;; or more complex computations as in the following example taken from
-;; an org file where each header in "results" subtree contained a
-;; property "sorted_hits" which was passed through the
-;; "average-precision" elisp function
-;;
-;; #+BEGIN: propview :id "results" :cols (ITEM (average-precision sorted_hits))
-;; | "ITEM" | "(average-precision sorted_hits)" |
-;; |-----------+-----------------------------------|
-;; | run (80) | 0.105092 |
-;; | run (70) | 0.108142 |
-;; | run (10) | 0.111348 |
-;; | run (60) | 0.113593 |
-;; | run (50) | 0.116446 |
-;; | run (100) | 0.118863 |
-;; #+END:
-;;
-
-;;; Code:
-(require 'org)
-(require 'org-table)
-
-(defvar org-propview-default-value 0
- "Default value to insert into the propview table when the no
-value is calculated either through lack of required variables for
-a column, or through the generation of an error.")
-
-(defun and-rest (list)
- (if (listp list)
- (if (> (length list) 1)
- (and (car list) (and-rest (cdr list)))
- (car list))
- list))
-
-(put 'org-collector-error
- 'error-conditions
- '(error column-prop-error org-collector-error))
-
-(defun org-read-prop (prop)
- "Convert the string property PROP to a number if appropriate.
-If prop looks like a list (meaning it starts with a '(') then
-read it as lisp expression, otherwise return it unmodified as a
-string.
-
-Results of calling:
-\(org-read-prop \"12\") -> 12
-\(org-read-prop \"(1 2 3)\") -> (1 2 3)
-\(org-read-prop \"+0\") -> 0
-\(org-read-prop \"aaa\") -> \"aaa\""
- (if (and (stringp prop) (not (equal prop "")))
- (let ((out (string-to-number prop)))
- (if (equal out 0)
- (cond
- ((or
- (equal "(" (substring prop 0 1))
- (equal "'" (substring prop 0 1)))
-
- (condition-case nil
- (read prop)
- (error prop)))
- ((string-match "^\\(+0\\|-0\\|0\\)$" prop)
- 0)
- (t
- (set-text-properties 0 (length prop) nil prop)
- prop))
- out))
- prop))
-
-(defun org-dblock-write:propview (params)
- "collect the column specification from the #+cols line
-preceeding the dblock, then update the contents of the dblock."
- (interactive)
- (condition-case er
- (let ((cols (plist-get params :cols))
- (conds (plist-get params :conds))
- (match (plist-get params :match))
- (scope (plist-get params :scope))
- (content-lines (org-split-string (plist-get params :content) "\n"))
- id table line pos)
- (save-excursion
- (when (setq id (plist-get params :id))
- (cond ((not id) nil)
- ((eq id 'global) (goto-char (point-min)))
- ((eq id 'local) nil)
- ((setq idpos (org-find-entry-with-id id))
- (goto-char idpos))
- (t (error "Cannot find entry with :ID: %s" id))))
- (org-narrow-to-subtree)
- (setq table (org-propview-to-table (org-propview-collect cols conds match scope)))
- (widen))
- (setq pos (point))
- (when content-lines
- (while (string-match "^#" (car content-lines))
- (insert (pop content-lines) "\n")))
- (insert table) (insert "\n|--") (org-cycle) (move-end-of-line 1)
- (message (format "point-%d" pos))
- (while (setq line (pop content-lines))
- (when (string-match "^#" line)
- (insert "\n" line)))
- (goto-char pos)
- (org-table-recalculate 'all))
- (org-collector-error (widen) (error "%s" er))
- (error (widen) (error "%s" er))))
-
-(defun org-propview-eval-w-props (props body)
- "evaluate the BODY-FORMS binding the variables using the
-variables and values specified in props"
- (condition-case nil ;; catch any errors
- (eval `(let ,(mapcar
- (lambda (pair) (list (intern (car pair)) (cdr pair)))
- props)
- ,body))
- (error nil)))
-
-(defun org-propview-collect (cols &optional conds match scope)
- (interactive)
- ;; collect the properties from every header
- (let* ((header-props
- (let ((org-trust-scanner-tags t))
- (org-map-entries (quote (cons (cons "ITEM" (org-get-heading t))
- (org-entry-properties)))
- match scope)))
- ;; read property values
- (header-props (mapcar (lambda (props)
- (mapcar (lambda (pair) (cons (car pair) (org-read-prop (cdr pair))))
- props))
- header-props))
- ;; collect all property names
- (prop-names (mapcar 'intern (delete-dups
- (apply 'append (mapcar (lambda (header)
- (mapcar 'car header))
- header-props))))))
- (append
- (list
- (mapcar (lambda (el) (format "%S" el)) cols) ;; output headers
- 'hline) ;; ------------------------------------------------
- (mapcar ;; calculate the value of the column for each header
- (lambda (props) (mapcar (lambda (col) (let ((result (org-propview-eval-w-props props col)))
- (if result result org-propview-default-value)))
- cols))
- (if conds
- ;; eliminate the headers which don't satisfy the property
- (delq nil
- (mapcar
- (lambda (props)
- (if (and-rest (mapcar (lambda (col) (org-propview-eval-w-props props col)) conds))
- props))
- header-props))
- header-props)))))
-
-(defun org-propview-to-table (results)
- ;; (message (format "cols:%S" cols))
- (orgtbl-to-orgtbl
- (mapcar
- (lambda (row)
- (if (equal row 'hline)
- 'hline
- (mapcar (lambda (el) (format "%S" el)) row)))
- (delq nil results)) '()))
-
-(provide 'org-collector)
-;;; org-collector ends here
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-contribdir.el b/.emacs.d/org-7.4/contrib/lisp/org-contribdir.el
deleted file mode 100644
index 92c50a0..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-contribdir.el
+++ /dev/null
@@ -1,38 +0,0 @@
-;;; org-contribdir.el --- Mark the location of the contrib directory
-;; Copyright (C) 2009 Free Software Foundation, Inc.
-;;
-;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: http://orgmode.org
-;; Version: 0.01
-;;
-;; This file is not yet 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, 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; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-;;
-
-;; The sole purpose of this file is to be located in the same place
-;; as where the contributed Org files are located, typically in the
-;; contrib/lisp directory of the Org-mode distribution. This is to
-;; make sure that the command `org-reload' can reliably locate
-;; contributed org files.
-
-(provide 'org-contribdir)
-
-;;; org-contribdir.el ends here
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-depend.el b/.emacs.d/org-7.4/contrib/lisp/org-depend.el
deleted file mode 100644
index 089a6a0..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-depend.el
+++ /dev/null
@@ -1,279 +0,0 @@
-;;; org-depend.el --- TODO dependencies for Org-mode
-;; Copyright (C) 2008 Free Software Foundation, Inc.
-;;
-;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: http://orgmode.org
-;; Version: 0.08
-;;
-;; This file is not part of GNU Emacs.
-;;
-;; This file 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, 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; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-;;
-;; WARNING: This file is just a PROOF OF CONCEPT, not a supported part
-;; of Org-mode.
-;;
-;; This is an example implementation of TODO dependencies in Org-mode.
-;; It uses the new hooks in version 5.13 of Org-mode,
-;; `org-trigger-hook' and `org-blocker-hook'.
-;;
-;; It implements the following:
-;;
-;; Triggering
-;; ----------
-;;
-;; 1) If an entry contains a TRIGGER property that contains the string
-;; "chain-siblings(KEYWORD)", then switching that entry to DONE does
-;; do the following:
-;; - The sibling following this entry switched to todo-state KEYWORD.
-;; - The sibling also gets a TRIGGER property "chain-sibling(KEYWORD)",
-;; property, to make sure that, when *it* is DONE, the chain will
-;; continue.
-;;
-;; 2) If an entry contains a TRIGGER property that contains the string
-;; "chain-siblings-scheduled", then switching that entry to DONE does
-;; the following actions, similarly to "chain-siblings(KEYWORD)":
-;; - The sibling receives the same scheduled time as the entry
-;; marked as DONE (or, in the case, in which there is no scheduled
-;; time, the sibling does not get any either).
-;; - The sibling also gets the same TRIGGER property
-;; "chain-siblings-scheduled", so the chain can continue.
-;;
-;; 3) If the TRIGGER property contains any other words like
-;; XYZ(KEYWORD), these are treated as entry id's with keywords. That
-;; means Org-mode will search for an entry with the ID property XYZ
-;; and switch that entry to KEYWORD as well.
-;;
-;; Blocking
-;; --------
-;;
-;; 1) If an entry contains a BLOCKER property that contains the word
-;; "previous-sibling", the sibling above the current entry is
-;; checked when you try to mark it DONE. If it is still in a TODO
-;; state, the current state change is blocked.
-;;
-;; 2) If the BLOCKER property contains any other words, these are
-;; treated as entry id's. That means Org-mode will search for an
-;; entry with the ID property exactly equal to this word. If any
-;; of these entries is not yet marked DONE, the current state change
-;; will be blocked.
-;;
-;; 3) Whenever a state change is blocked, an org-mark is pushed, so that
-;; you can find the offending entry with `C-c &'.
-;;
-;;; Example:
-;;
-;; When trying this example, make sure that the settings for TODO keywords
-;; have been activated, i.e. include the following line and press C-c C-c
-;; on the line before working with the example:
-;;
-;; #+TYP_TODO: TODO NEXT | DONE
-;;
-;; * TODO Win a million in Las Vegas
-;; The "third" TODO (see above) cannot become a TODO without this money.
-;;
-;; :PROPERTIES:
-;; :ID: I-cannot-do-it-without-money
-;; :END:
-;;
-;; * Do this by doing a chain of TODO's
-;; ** NEXT This is the first in this chain
-;; :PROPERTIES:
-;; :TRIGGER: chain-siblings(NEXT)
-;; :END:
-;;
-;; ** This is the second in this chain
-;;
-;; ** This is the third in this chain
-;; :PROPERTIES:
-;; :BLOCKER: I-cannot-do-it-without-money
-;; :END:
-;;
-;; ** This is the forth in this chain
-;; When this is DONE, we will also trigger entry XYZ-is-my-id
-;; :PROPERTIES:
-;; :TRIGGER: XYZ-is-my-id(TODO)
-;; :END:
-;;
-;; ** This is the fifth in this chain
-;;
-;; * Start writing report
-;; :PROPERTIES:
-;; :ID: XYZ-is-my-id
-;; :END:
-;;
-;;
-
-(require 'org)
-
-(defcustom org-depend-tag-blocked t
- "Whether to indicate blocked TODO items by a special tag."
- :group 'org
- :type 'boolean)
-
-(defmacro org-depend-act-on-sibling (trigger-val &rest rest)
- "Perform a set of actions on the next sibling, if it exists,
-copying the sibling spec TRIGGER-VAL to the next sibling."
- `(catch 'exit
- (save-excursion
- (goto-char pos)
- ;; find the sibling, exit if no more siblings
- (condition-case nil
- (outline-forward-same-level 1)
- (error (throw 'exit t)))
- ;; mark the sibling TODO
- ,@rest
- ;; make sure the sibling will continue the chain
- (org-entry-add-to-multivalued-property
- nil "TRIGGER" ,trigger-val))))
-
-(defun org-depend-trigger-todo (change-plist)
- "Trigger new TODO entries after the current is switched to DONE.
-This does two different kinds of triggers:
-
-- If the current entry contains a TRIGGER property that contains
- \"chain-siblings(KEYWORD)\", it goes to the next sibling, marks it
- KEYWORD and also installs the \"chain-sibling\" trigger to continue
- the chain.
-- If the current entry contains a TRIGGER property that contains
- \"chain-siblings-scheduled\", we go to the next sibling and copy
- the scheduled time from the current task, also installing the property
- in the sibling.
-- Any other word (space-separated) like XYZ(KEYWORD) in the TRIGGER
- property is seen as an entry id. Org-mode finds the entry with the
- corresponding ID property and switches it to the state TODO as well."
-
- ;; Get information from the plist
- (let* ((type (plist-get change-plist :type))
- (pos (plist-get change-plist :position))
- (from (plist-get change-plist :from))
- (to (plist-get change-plist :to))
- (org-log-done nil) ; IMPROTANT!: no logging during automatic trigger!
- trigger triggers tr p1 kwd)
- (catch 'return
- (unless (eq type 'todo-state-change)
- ;; We are only handling todo-state-change....
- (throw 'return t))
- (unless (and (member from org-not-done-keywords)
- (member to org-done-keywords))
- ;; This is not a change from TODO to DONE, ignore it
- (throw 'return t))
-
- ;; OK, we just switched from a TODO state to a DONE state
- ;; Lets see if this entry has a TRIGGER property.
- ;; If yes, split it up on whitespace.
- (setq trigger (org-entry-get pos "TRIGGER")
- triggers (and trigger (org-split-string trigger "[ \t]+")))
-
- ;; Go through all the triggers
- (while (setq tr (pop triggers))
- (cond
- ((string-match "\\`chain-siblings(\\(.*?\\))\\'" tr)
- ;; This is a TODO chain of siblings
- (setq kwd (match-string 1 tr))
- (org-depend-act-on-sibling (format "chain-siblings(%s)" kwd)
- (org-todo kwd)))
-
- ((string-match "\\`\\(\\S-+\\)(\\(.*?\\))\\'" tr)
- ;; This seems to be ENTRY_ID(KEYWORD)
- (setq id (match-string 1 tr)
- kwd (match-string 2 tr)
- p1 (org-find-entry-with-id id))
- (when p1
- ;; there is an entry with this ID, mark it TODO
- (save-excursion
- (goto-char p1)
- (org-todo kwd))))
- ((string-match "\\`chain-siblings-scheduled\\'" tr)
- (let ((time (org-get-scheduled-time pos)))
- (when time
- (org-depend-act-on-sibling
- "chain-siblings-scheduled"
- (org-schedule nil time))))))))))
-
-(defun org-depend-block-todo (change-plist)
- "Block turning an entry into a TODO.
-This checks for a BLOCKER property in an entry and checks
-all the entries listed there. If any of them is not done,
-block changing the current entry into a TODO entry. If the property contains
-the word \"previous-sibling\", the sibling above the current entry is checked.
-Any other words are treated as entry id's. If an entry exists with the
-this ID property, that entry is also checked."
- ;; Get information from the plist
- (let* ((type (plist-get change-plist :type))
- (pos (plist-get change-plist :position))
- (from (plist-get change-plist :from))
- (to (plist-get change-plist :to))
- (org-log-done nil) ; IMPROTANT!: no logging during automatic trigger
- blocker blockers bl p1
- (proceed-p
- (catch 'return
- ;; If this is not a todo state change, or if this entry is
- ;; DONE, do not block
- (when (or (not (eq type 'todo-state-change))
- (member from (cons 'done org-done-keywords))
- (member to (cons 'todo org-not-done-keywords))
- (not to))
- (throw 'return t))
-
- ;; OK, the plan is to switch from nothing to TODO
- ;; Lets see if we will allow it. Find the BLOCKER property
- ;; and split it on whitespace.
- (setq blocker (org-entry-get pos "BLOCKER")
- blockers (and blocker (org-split-string blocker "[ \t]+")))
-
- ;; go through all the blockers
- (while (setq bl (pop blockers))
- (cond
- ((equal bl "previous-sibling")
- ;; the sibling is required to be DONE.
- (catch 'ignore
- (save-excursion
- (goto-char pos)
- ;; find the older sibling, exit if no more siblings
- (condition-case nil
- (outline-backward-same-level 1)
- (error (throw 'ignore t)))
- ;; Check if this entry is not yet done and block
- (unless (org-entry-is-done-p)
- ;; return nil, to indicate that we block the change!
- (org-mark-ring-push)
- (throw 'return nil)))))
-
- ((setq p1 (org-find-entry-with-id bl))
- ;; there is an entry with this ID, check it out
- (save-excursion
- (goto-char p1)
- (unless (org-entry-is-done-p)
- ;; return nil, to indicate that we block the change!
- (org-mark-ring-push)
- (throw 'return nil))))))
- t ; return t to indicate that we are not blocking
- )))
- (when org-depend-tag-blocked
- (org-toggle-tag "blocked" (if proceed-p 'off 'on)))
-
- proceed-p))
-
-(add-hook 'org-trigger-hook 'org-depend-trigger-todo)
-(add-hook 'org-blocker-hook 'org-depend-block-todo)
-
-(provide 'org-depend)
-
-;;; org-depend.el ends here
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-drill.el b/.emacs.d/org-7.4/contrib/lisp/org-drill.el
deleted file mode 100644
index 6b5ff06..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-drill.el
+++ /dev/null
@@ -1,1144 +0,0 @@
-;;; org-drill.el - Self-testing with org-learn
-;;;
-;;; Author: Paul Sexton <eeeickythump@gmail.com>
-;;; Version: 1.4
-;;; Repository at http://bitbucket.org/eeeickythump/org-drill/
-;;;
-;;;
-;;; Synopsis
-;;; ========
-;;;
-;;; Uses the spaced repetition algorithm in `org-learn' to conduct interactive
-;;; "drill sessions", where the material to be remembered is presented to the
-;;; student in random order. The student rates his or her recall of each item,
-;;; and this information is fed back to `org-learn' to schedule the item for
-;;; later revision.
-;;;
-;;; Each drill session can be restricted to topics in the current buffer
-;;; (default), one or several files, all agenda files, or a subtree. A single
-;;; topic can also be drilled.
-;;;
-;;; Different "card types" can be defined, which present their information to
-;;; the student in different ways.
-;;;
-;;; See the file README.org for more detailed documentation.
-
-
-(eval-when-compile (require 'cl))
-(eval-when-compile (require 'hi-lock))
-(require 'org)
-(require 'org-learn)
-
-
-(defgroup org-drill nil
- "Options concerning interactive drill sessions in Org mode (org-drill)."
- :tag "Org-Drill"
- :group 'org-link)
-
-
-
-(defcustom org-drill-question-tag
- "drill"
- "Tag which topics must possess in order to be identified as review topics
-by `org-drill'."
- :group 'org-drill
- :type 'string)
-
-
-
-(defcustom org-drill-maximum-items-per-session
- 30
- "Each drill session will present at most this many topics for review.
-Nil means unlimited."
- :group 'org-drill
- :type '(choice integer (const nil)))
-
-
-
-(defcustom org-drill-maximum-duration
- 20
- "Maximum duration of a drill session, in minutes.
-Nil means unlimited."
- :group 'org-drill
- :type '(choice integer (const nil)))
-
-
-(defcustom org-drill-failure-quality
- 2
- "If the quality of recall for an item is this number or lower,
-it is regarded as an unambiguous failure, and the repetition
-interval for the card is reset to 0 days. By default this is
-2. For Mnemosyne-like behaviour, set it to 1. Other values are
-not really sensible."
- :group 'org-drill
- :type '(choice (const 2) (const 1)))
-
-
-(defcustom org-drill-leech-failure-threshold
- 15
- "If an item is forgotten more than this many times, it is tagged
-as a 'leech' item."
- :group 'org-drill
- :type '(choice integer (const nil)))
-
-
-(defcustom org-drill-leech-method
- 'skip
- "How should 'leech items' be handled during drill sessions?
-Possible values:
-- nil :: Leech items are treated the same as normal items.
-- skip :: Leech items are not included in drill sessions.
-- warn :: Leech items are still included in drill sessions,
- but a warning message is printed when each leech item is
- presented."
- :group 'org-drill
- :type '(choice (const 'warn) (const 'skip) (const nil)))
-
-
-(defface org-drill-visible-cloze-face
- '((t (:foreground "darkseagreen")))
- "The face used to hide the contents of cloze phrases."
- :group 'org-drill)
-
-
-(defface org-drill-visible-cloze-hint-face
- '((t (:foreground "dark slate blue")))
- "The face used to hide the contents of cloze phrases."
- :group 'org-drill)
-
-
-(defcustom org-drill-use-visible-cloze-face-p
- nil
- "Use a special face to highlight cloze-deleted text in org mode
-buffers?"
- :group 'org-drill
- :type 'boolean)
-
-
-(defface org-drill-hidden-cloze-face
- '((t (:foreground "deep sky blue" :background "blue")))
- "The face used to hide the contents of cloze phrases."
- :group 'org-drill)
-
-
-(defcustom org-drill-new-count-color
- "royal blue"
- "Foreground colour used to display the count of remaining new items
-during a drill session."
- :group 'org-drill
- :type 'color)
-
-(defcustom org-drill-mature-count-color
- "green"
- "Foreground colour used to display the count of remaining mature items
-during a drill session. Mature items are due for review, but are not new."
- :group 'org-drill
- :type 'color)
-
-(defcustom org-drill-failed-count-color
- "red"
- "Foreground colour used to display the count of remaining failed items
-during a drill session."
- :group 'org-drill
- :type 'color)
-
-(defcustom org-drill-done-count-color
- "sienna"
- "Foreground colour used to display the count of reviewed items
-during a drill session."
- :group 'org-drill
- :type 'color)
-
-
-(setplist 'org-drill-cloze-overlay-defaults
- '(display "[...]"
- face org-drill-hidden-cloze-face
- window t))
-
-
-(defvar org-drill-cloze-regexp
- ;; ver 1 "[^][]\\(\\[[^][][^]]*\\]\\)"
- ;; ver 2 "\\(\\[.*?\\]\\|^[^[[:cntrl:]]*?\\]\\|\\[.*?$\\)"
- ;; ver 3! "\\(\\[.*?\\]\\|\\[.*?[[:cntrl:]]+.*?\\]\\)"
- "\\(\\[[[:cntrl:][:graph:][:space:]]*?\\)\\(\\||.+?\\)\\(\\]\\)")
-
-(defvar org-drill-cloze-keywords
- `((,org-drill-cloze-regexp
- (1 'org-drill-visible-cloze-face nil)
- (2 'org-drill-visible-cloze-hint-face t)
- (3 'org-drill-visible-cloze-face nil)
- )))
-
-
-(defcustom org-drill-card-type-alist
- '((nil . org-drill-present-simple-card)
- ("simple" . org-drill-present-simple-card)
- ("twosided" . org-drill-present-two-sided-card)
- ("multisided" . org-drill-present-multi-sided-card)
- ("multicloze" . org-drill-present-multicloze)
- ("spanish_verb" . org-drill-present-spanish-verb))
- "Alist associating card types with presentation functions. Each entry in the
-alist takes the form (CARDTYPE . FUNCTION), where CARDTYPE is a string
-or nil, and FUNCTION is a function which takes no arguments and returns a
-boolean value."
- :group 'org-drill
- :type '(alist :key-type (choice string (const nil)) :value-type function))
-
-
-(defcustom org-drill-spaced-repetition-algorithm
- 'sm5
- "Which SuperMemo spaced repetition algorithm to use for scheduling items.
-Available choices are SM2 and SM5."
- :group 'org-drill
- :type '(choice (const 'sm2) (const 'sm5)))
-
-(defcustom org-drill-add-random-noise-to-intervals-p
- nil
- "If true, the number of days until an item's next repetition
-will vary slightly from the interval calculated by the SM2
-algorithm. The variation is very small when the interval is
-small, and scales up with the interval. The code for calculating
-random noise is adapted from Mnemosyne."
- :group 'org-drill
- :type 'boolean)
-
-(defcustom org-drill-cram-hours
- 12
- "When in cram mode, items are considered due for review if
-they were reviewed at least this many hours ago."
- :group 'org-drill
- :type 'integer)
-
-
-(defvar *org-drill-session-qualities* nil)
-(defvar *org-drill-start-time* 0)
-(defvar *org-drill-new-entries* nil)
-(defvar *org-drill-mature-entries* nil)
-(defvar *org-drill-failed-entries* nil)
-(defvar *org-drill-again-entries* nil)
-(defvar *org-drill-done-entries* nil)
-(defvar *org-drill-cram-mode* nil
- "Are we in 'cram mode', where all items are considered due
-for review unless they were already reviewed in the recent past?")
-
-
-
-;;;; Utilities ================================================================
-
-
-(defun free-marker (m)
- (set-marker m nil))
-
-
-(defmacro pop-random (place)
- (let ((elt (gensym)))
- `(if (null ,place)
- nil
- (let ((,elt (nth (random (length ,place)) ,place)))
- (setq ,place (remove ,elt ,place))
- ,elt))))
-
-
-(defun shuffle-list (list)
- "Randomly permute the elements of LIST (all permutations equally likely)."
- ;; Adapted from 'shuffle-vector' in cookie1.el
- (let ((i 0)
- j
- temp
- (len (length list)))
- (while (< i len)
- (setq j (+ i (random (- len i))))
- (setq temp (nth i list))
- (setf (nth i list) (nth j list))
- (setf (nth j list) temp)
- (setq i (1+ i))))
- list)
-
-
-(defun time-to-inactive-org-timestamp (time)
- (format-time-string
- (concat "[" (substring (cdr org-time-stamp-formats) 1 -1) "]")
- time))
-
-
-
-(defmacro with-hidden-cloze-text (&rest body)
- `(progn
- (org-drill-hide-clozed-text)
- (unwind-protect
- (progn
- ,@body)
- (org-drill-unhide-clozed-text))))
-
-
-(defun org-drill-days-since-last-review ()
- "Nil means a last review date has not yet been stored for
-the item.
-Zero means it was reviewed today.
-A positive number means it was reviewed that many days ago.
-A negative number means the date of last review is in the future --
-this should never happen."
- (let ((datestr (org-entry-get (point) "DRILL_LAST_REVIEWED")))
- (when datestr
- (- (time-to-days (current-time))
- (time-to-days (apply 'encode-time
- (org-parse-time-string datestr)))))))
-
-
-(defun org-drill-hours-since-last-review ()
- "Like `org-drill-days-since-last-review', but return value is
-in hours rather than days."
- (let ((datestr (org-entry-get (point) "DRILL_LAST_REVIEWED")))
- (when datestr
- (floor
- (/ (- (time-to-seconds (current-time))
- (time-to-seconds (apply 'encode-time
- (org-parse-time-string datestr))))
- (* 60 60))))))
-
-
-(defun org-drill-entry-p ()
- "Is the current entry a 'drill item'?"
- (or (org-entry-get (point) "LEARN_DATA")
- ;;(assoc "LEARN_DATA" (org-entry-properties nil))
- (member org-drill-question-tag (org-get-local-tags))))
-
-
-(defun org-part-of-drill-entry-p ()
- "Is the current entry either the main heading of a 'drill item',
-or a subheading within a drill item?"
- (or (org-drill-entry-p)
- ;; Does this heading INHERIT the drill tag
- (member org-drill-question-tag (org-get-tags-at))))
-
-
-(defun org-drill-goto-drill-entry-heading ()
- "Move the point to the heading which hold the :drill: tag for this
-drill entry."
- (unless (org-at-heading-p)
- (org-back-to-heading))
- (unless (org-part-of-drill-entry-p)
- (error "Point is not inside a drill entry"))
- (while (not (org-drill-entry-p))
- (unless (org-up-heading-safe)
- (error "Cannot find a parent heading that is marked as a drill entry"))))
-
-
-
-(defun org-drill-entry-leech-p ()
- "Is the current entry a 'leech item'?"
- (and (org-drill-entry-p)
- (member "leech" (org-get-local-tags))))
-
-
-(defun org-drill-entry-due-p ()
- (cond
- (*org-drill-cram-mode*
- (let ((hours (org-drill-hours-since-last-review)))
- (and (org-drill-entry-p)
- (or (null hours)
- (>= hours org-drill-cram-hours)))))
- (t
- (let ((item-time (org-get-scheduled-time (point))))
- (and (org-drill-entry-p)
- (or (not (eql 'skip org-drill-leech-method))
- (not (org-drill-entry-leech-p)))
- (or (null item-time)
- (not (minusp ; scheduled for today/in future
- (- (time-to-days (current-time))
- (time-to-days item-time))))))))))
-
-
-(defun org-drill-entry-new-p ()
- (and (org-drill-entry-p)
- (let ((item-time (org-get-scheduled-time (point))))
- (null item-time))))
-
-
-
-(defun org-drill-entry-last-quality ()
- (let ((quality (org-entry-get (point) "DRILL_LAST_QUALITY")))
- (if quality
- (string-to-number quality)
- nil)))
-
-
-;;; SM2 Algorithm =============================================================
-
-
-(defun determine-next-interval-sm2 (last-interval n ef quality of-matrix)
- "Arguments:
-- LAST-INTERVAL -- the number of days since the item was last reviewed.
-- N -- the number of times the item has been successfully reviewed
-- EF -- the 'easiness factor'
-- QUALITY -- 0 to 5
-- OF-MATRIX -- a matrix of values, used by SM5 but not by SM2.
-
-Returns a list: (INTERVAL N EF OFMATRIX), where:
-- INTERVAL is the number of days until the item should next be reviewed
-- N is incremented by 1.
-- EF is modified based on the recall quality for the item.
-- OF-MATRIX is not modified."
- (assert (> n 0))
- (assert (and (>= quality 0) (<= quality 5)))
- (if (<= quality org-drill-failure-quality)
- ;; When an item is failed, its interval is reset to 0,
- ;; but its EF is unchanged
- (list -1 1 ef of-matrix)
- ;; else:
- (let* ((next-ef (modify-e-factor ef quality))
- (interval
- (cond
- ((<= n 1) 1)
- ((= n 2)
- (cond
- (org-drill-add-random-noise-to-intervals-p
- (case quality
- (5 6)
- (4 4)
- (3 3)
- (2 1)
- (t -1)))
- (t 6)))
- (t (ceiling (* last-interval next-ef))))))
- (list (round
- (if org-drill-add-random-noise-to-intervals-p
- (+ last-interval (* (- interval last-interval)
- (org-drill-random-dispersal-factor)))
- interval))
- (1+ n) next-ef of-matrix))))
-
-
-;;; SM5 Algorithm =============================================================
-
-;;; From http://www.supermemo.com/english/ol/sm5.htm
-(defun org-drill-random-dispersal-factor ()
- (let ((a 0.047)
- (b 0.092)
- (p (- (random* 1.0) 0.5)))
- (flet ((sign (n)
- (cond ((zerop n) 0)
- ((plusp n) 1)
- (t -1))))
- (/ (+ 100 (* (* (/ -1 b) (log (- 1 (* (/ b a ) (abs p)))))
- (sign p)))
- 100))))
-
-
-(defun inter-repetition-interval-sm5 (last-interval n ef &optional of-matrix)
- (let ((of (get-optimal-factor n ef of-matrix)))
- (if (= 1 n)
- of
- (* of last-interval))))
-
-
-(defun determine-next-interval-sm5 (last-interval n ef quality of-matrix)
- (assert (> n 0))
- (assert (and (>= quality 0) (<= quality 5)))
- (let ((next-ef (modify-e-factor ef quality))
- (interval nil))
- (setq of-matrix
- (set-optimal-factor n next-ef of-matrix
- (modify-of (get-optimal-factor n ef of-matrix)
- quality org-learn-fraction))
- ef next-ef)
-
- (cond
- ;; "Failed" -- reset repetitions to 0,
- ((<= quality org-drill-failure-quality)
- (list -1 1 ef of-matrix)) ; Not clear if OF matrix is supposed to be
- ; preserved
- ;; For a zero-based quality of 4 or 5, don't repeat
- ((and (>= quality 4)
- (not org-learn-always-reschedule))
- (list 0 (1+ n) ef of-matrix)) ; 0 interval = unschedule
- (t
- (setq interval (inter-repetition-interval-sm5
- last-interval n ef of-matrix))
- (if org-drill-add-random-noise-to-intervals-p
- (setq interval (+ last-interval
- (* (- interval last-interval)
- (org-drill-random-dispersal-factor)))))
- (list (round interval) (1+ n) ef of-matrix)))))
-
-
-;;; Essentially copied from `org-learn.el', but modified to
-;;; optionally call the SM2 function above.
-(defun org-drill-smart-reschedule (quality)
- (interactive "nHow well did you remember the information (on a scale of 0-5)? ")
- (let* ((learn-str (org-entry-get (point) "LEARN_DATA"))
- (learn-data (or (and learn-str
- (read learn-str))
- (copy-list initial-repetition-state)))
- closed-dates)
- (setq learn-data
- (case org-drill-spaced-repetition-algorithm
- (sm5 (determine-next-interval-sm5 (nth 0 learn-data)
- (nth 1 learn-data)
- (nth 2 learn-data)
- quality
- (nth 3 learn-data)))
- (sm2 (determine-next-interval-sm2 (nth 0 learn-data)
- (nth 1 learn-data)
- (nth 2 learn-data)
- quality
- (nth 3 learn-data)))))
- (org-entry-put (point) "LEARN_DATA" (prin1-to-string learn-data))
- (cond
- ((= 0 (nth 0 learn-data))
- (org-schedule t))
- ((minusp (first learn-data))
- (org-schedule nil (current-time)))
- (t
- (org-schedule nil (time-add (current-time)
- (days-to-time (nth 0 learn-data))))))))
-
-
-(defun org-drill-reschedule ()
- "Returns quality rating (0-5), or nil if the user quit."
- (let ((ch nil))
- (while (not (memq ch '(?q ?e ?0 ?1 ?2 ?3 ?4 ?5)))
- (setq ch (read-char-exclusive
- (if (eq ch ??)
- "0-2 Means you have forgotten the item.
-3-5 Means you have remembered the item.
-
-0 - Completely forgot.
-1 - Even after seeing the answer, it still took a bit to sink in.
-2 - After seeing the answer, you remembered it.
-3 - It took you awhile, but you finally remembered.
-4 - After a little bit of thought you remembered.
-5 - You remembered the item really easily.
-
-How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)"
- "How well did you do? (0-5, ?=help, e=edit, q=quit)")))
- (if (eql ch ?t)
- (org-set-tags-command)))
- (cond
- ((and (>= ch ?0) (<= ch ?5))
- (let ((quality (- ch ?0))
- (failures (org-entry-get (point) "DRILL_FAILURE_COUNT")))
- (save-excursion
- (org-drill-smart-reschedule quality))
- (push quality *org-drill-session-qualities*)
- (cond
- ((<= quality org-drill-failure-quality)
- (when org-drill-leech-failure-threshold
- (setq failures (if failures (string-to-number failures) 0))
- (org-set-property "DRILL_FAILURE_COUNT"
- (format "%d" (1+ failures)))
- (if (> (1+ failures) org-drill-leech-failure-threshold)
- (org-toggle-tag "leech" 'on))))
- (t
- (let ((scheduled-time (org-get-scheduled-time (point))))
- (when scheduled-time
- (message "Next review in %d days"
- (- (time-to-days scheduled-time)
- (time-to-days (current-time))))
- (sit-for 0.5)))))
- (org-set-property "DRILL_LAST_QUALITY" (format "%d" quality))
- (org-set-property "DRILL_LAST_REVIEWED"
- (time-to-inactive-org-timestamp (current-time)))
- quality))
- ((= ch ?e)
- 'edit)
- (t
- nil))))
-
-
-(defun org-drill-hide-all-subheadings-except (heading-list)
- "Returns a list containing the position of each immediate subheading of
-the current topic."
- (let ((drill-entry-level (org-current-level))
- (drill-sections nil)
- (drill-heading nil))
- (org-show-subtree)
- (save-excursion
- (org-map-entries
- (lambda ()
- (when (= (org-current-level) (1+ drill-entry-level))
- (setq drill-heading (org-get-heading t))
- (unless (member drill-heading heading-list)
- (hide-subtree))
- (push (point) drill-sections)))
- "" 'tree))
- (reverse drill-sections)))
-
-
-
-(defun org-drill-presentation-prompt (&rest fmt-and-args)
- (let* ((item-start-time (current-time))
- (ch nil)
- (last-second 0)
- (prompt
- (if fmt-and-args
- (apply 'format
- (first fmt-and-args)
- (rest fmt-and-args))
- (concat "Press key for answer, "
- "e=edit, t=tags, s=skip, q=quit."))))
- (setq prompt
- (format "%s %s %s %s %s"
- (propertize
- (number-to-string (length *org-drill-done-entries*))
- 'face `(:foreground ,org-drill-done-count-color)
- 'help-echo "The number of items you have reviewed this session.")
- (propertize
- (number-to-string (+ (length *org-drill-again-entries*)
- (length *org-drill-failed-entries*)))
- 'face `(:foreground ,org-drill-failed-count-color)
- 'help-echo (concat "The number of items that you failed, "
- "and need to review again."))
- (propertize
- (number-to-string (length *org-drill-mature-entries*))
- 'face `(:foreground ,org-drill-mature-count-color)
- 'help-echo "The number of old items due for review.")
- (propertize
- (number-to-string (length *org-drill-new-entries*))
- 'face `(:foreground ,org-drill-new-count-color)
- 'help-echo (concat "The number of new items that you "
- "have never reviewed."))
- prompt))
- (if (and (eql 'warn org-drill-leech-method)
- (org-drill-entry-leech-p))
- (setq prompt (concat
- (propertize "!!! LEECH ITEM !!!
-You seem to be having a lot of trouble memorising this item.
-Consider reformulating the item to make it easier to remember.\n"
- 'face '(:foreground "red"))
- prompt)))
- (while (memq ch '(nil ?t))
- (while (not (input-pending-p))
- (message (concat (format-time-string
- "%M:%S " (time-subtract
- (current-time) item-start-time))
- prompt))
- (sit-for 1))
- (setq ch (read-char-exclusive))
- (if (eql ch ?t)
- (org-set-tags-command)))
- (case ch
- (?q nil)
- (?e 'edit)
- (?s 'skip)
- (otherwise t))))
-
-
-(defun org-pos-in-regexp (pos regexp &optional nlines)
- (save-excursion
- (goto-char pos)
- (org-in-regexp regexp nlines)))
-
-
-(defun org-drill-hide-clozed-text ()
- (save-excursion
- (while (re-search-forward org-drill-cloze-regexp nil t)
- ;; Don't hide org links, partly because they might contain inline
- ;; images which we want to keep visible
- (unless (org-pos-in-regexp (match-beginning 0)
- org-bracket-link-regexp 1)
- (org-drill-hide-matched-cloze-text)))))
-
-
-(defun org-drill-hide-matched-cloze-text ()
- "Hide the current match with a 'cloze' visual overlay."
- (let ((ovl (make-overlay (match-beginning 0) (match-end 0))))
- (overlay-put ovl 'category
- 'org-drill-cloze-overlay-defaults)
- (when (find ?| (match-string 0))
- (overlay-put ovl
- 'display
- (format "[...%s]"
- (substring-no-properties
- (match-string 0)
- (1+ (position ?| (match-string 0)))
- (1- (length (match-string 0)))))))))
-
-
-(defun org-drill-unhide-clozed-text ()
- (save-excursion
- (dolist (ovl (overlays-in (point-min) (point-max)))
- (when (eql 'org-drill-cloze-overlay-defaults (overlay-get ovl 'category))
- (delete-overlay ovl)))))
-
-
-
-;;; Presentation functions ====================================================
-
-;; Each of these is called with point on topic heading. Each needs to show the
-;; topic in the form of a 'question' or with some information 'hidden', as
-;; appropriate for the card type. The user should then be prompted to press a
-;; key. The function should then reveal either the 'answer' or the entire
-;; topic, and should return t if the user chose to see the answer and rate their
-;; recall, nil if they chose to quit.
-
-(defun org-drill-present-simple-card ()
- (with-hidden-cloze-text
- (org-drill-hide-all-subheadings-except nil)
- (org-display-inline-images t)
- (org-cycle-hide-drawers 'all)
- (prog1 (org-drill-presentation-prompt)
- (org-show-subtree))))
-
-
-(defun org-drill-present-two-sided-card ()
- (with-hidden-cloze-text
- (let ((drill-sections (org-drill-hide-all-subheadings-except nil)))
- (when drill-sections
- (save-excursion
- (goto-char (nth (random (min 2 (length drill-sections)))
- drill-sections))
- (org-show-subtree)))
- (org-display-inline-images t)
- (org-cycle-hide-drawers 'all)
- (prog1
- (org-drill-presentation-prompt)
- (org-show-subtree)))))
-
-
-
-(defun org-drill-present-multi-sided-card ()
- (with-hidden-cloze-text
- (let ((drill-sections (org-drill-hide-all-subheadings-except nil)))
- (when drill-sections
- (save-excursion
- (goto-char (nth (random (length drill-sections)) drill-sections))
- (org-show-subtree)))
- (org-display-inline-images t)
- (org-cycle-hide-drawers 'all)
- (prog1
- (org-drill-presentation-prompt)
- (org-show-subtree)))))
-
-
-(defun org-drill-present-multicloze ()
- (let ((item-end nil)
- (match-count 0)
- (body-start (or (cdr (org-get-property-block))
- (point))))
- (org-drill-hide-all-subheadings-except nil)
- (save-excursion
- (outline-next-heading)
- (setq item-end (point)))
- (save-excursion
- (goto-char body-start)
- (while (re-search-forward org-drill-cloze-regexp item-end t)
- (incf match-count)))
- (when (plusp match-count)
- (save-excursion
- (goto-char body-start)
- (re-search-forward org-drill-cloze-regexp
- item-end t (1+ (random match-count)))
- (org-drill-hide-matched-cloze-text)))
- (org-display-inline-images t)
- (org-cycle-hide-drawers 'all)
- (prog1 (org-drill-presentation-prompt)
- (org-show-subtree)
- (org-drill-unhide-clozed-text))))
-
-
-(defun org-drill-present-spanish-verb ()
- (let ((prompt nil)
- (reveal-headings nil))
- (with-hidden-cloze-text
- (case (random 6)
- (0
- (org-drill-hide-all-subheadings-except '("Infinitive"))
- (setq prompt
- (concat "Translate this Spanish verb, and conjugate it "
- "for the *present* tense.")
- reveal-headings '("English" "Present Tense" "Notes")))
- (1
- (org-drill-hide-all-subheadings-except '("English"))
- (setq prompt (concat "For the *present* tense, conjugate the "
- "Spanish translation of this English verb.")
- reveal-headings '("Infinitive" "Present Tense" "Notes")))
- (2
- (org-drill-hide-all-subheadings-except '("Infinitive"))
- (setq prompt (concat "Translate this Spanish verb, and "
- "conjugate it for the *past* tense.")
- reveal-headings '("English" "Past Tense" "Notes")))
- (3
- (org-drill-hide-all-subheadings-except '("English"))
- (setq prompt (concat "For the *past* tense, conjugate the "
- "Spanish translation of this English verb.")
- reveal-headings '("Infinitive" "Past Tense" "Notes")))
- (4
- (org-drill-hide-all-subheadings-except '("Infinitive"))
- (setq prompt (concat "Translate this Spanish verb, and "
- "conjugate it for the *future perfect* tense.")
- reveal-headings '("English" "Future Perfect Tense" "Notes")))
- (5
- (org-drill-hide-all-subheadings-except '("English"))
- (setq prompt (concat "For the *future perfect* tense, conjugate the "
- "Spanish translation of this English verb.")
- reveal-headings '("Infinitive" "Future Perfect Tense" "Notes"))))
- (org-cycle-hide-drawers 'all)
- (prog1
- (org-drill-presentation-prompt prompt)
- (org-drill-hide-all-subheadings-except reveal-headings)))))
-
-
-
-(defun org-drill-entry ()
- "Present the current topic for interactive review, as in `org-drill'.
-Review will occur regardless of whether the topic is due for review or whether
-it meets the definition of a 'review topic' used by `org-drill'.
-
-Returns a quality rating from 0 to 5, or nil if the user quit, or the symbol
-EDIT if the user chose to exit the drill and edit the current item.
-
-See `org-drill' for more details."
- (interactive)
- (org-drill-goto-drill-entry-heading)
- ;;(unless (org-part-of-drill-entry-p)
- ;; (error "Point is not inside a drill entry"))
- ;;(unless (org-at-heading-p)
- ;; (org-back-to-heading))
- (let ((card-type (org-entry-get (point) "DRILL_CARD_TYPE"))
- (cont nil))
- (save-restriction
- (org-narrow-to-subtree)
- (org-show-subtree)
- (org-cycle-hide-drawers 'all)
-
- (let ((presentation-fn (cdr (assoc card-type org-drill-card-type-alist))))
- (cond
- (presentation-fn
- (setq cont (funcall presentation-fn)))
- (t
- (error "Unknown card type: '%s'" card-type))))
-
- (cond
- ((not cont)
- (message "Quit")
- nil)
- ((eql cont 'edit)
- 'edit)
- ((eql cont 'skip)
- 'skip)
- (t
- (save-excursion
- (org-drill-reschedule)))))))
-
-
-;; (defun org-drill-entries (entries)
-;; "Returns nil, t, or a list of markers representing entries that were
-;; 'failed' and need to be presented again before the session ends."
-;; (let ((again-entries nil))
-;; (setq *org-drill-done-entry-count* 0
-;; *org-drill-pending-entry-count* (length entries))
-;; (if (and org-drill-maximum-items-per-session
-;; (> (length entries)
-;; org-drill-maximum-items-per-session))
-;; (setq entries (subseq entries 0
-;; org-drill-maximum-items-per-session)))
-;; (block org-drill-entries
-;; (dolist (m entries)
-;; (save-restriction
-;; (switch-to-buffer (marker-buffer m))
-;; (goto-char (marker-position m))
-;; (setq result (org-drill-entry))
-;; (cond
-;; ((null result)
-;; (message "Quit")
-;; (return-from org-drill-entries nil))
-;; ((eql result 'edit)
-;; (setq end-pos (point-marker))
-;; (return-from org-drill-entries nil))
-;; (t
-;; (cond
-;; ((< result 3)
-;; (push m again-entries))
-;; (t
-;; (decf *org-drill-pending-entry-count*)
-;; (incf *org-drill-done-entry-count*)))
-;; (when (and org-drill-maximum-duration
-;; (> (- (float-time (current-time)) *org-drill-start-time*)
-;; (* org-drill-maximum-duration 60)))
-;; (message "This drill session has reached its maximum duration.")
-;; (return-from org-drill-entries nil))))))
-;; (or again-entries
-;; t))))
-
-
-(defun org-drill-entries-pending-p ()
- (or *org-drill-again-entries*
- (and (not (org-drill-maximum-item-count-reached-p))
- (not (org-drill-maximum-duration-reached-p))
- (or *org-drill-new-entries*
- *org-drill-failed-entries*
- *org-drill-mature-entries*
- *org-drill-again-entries*))))
-
-
-(defun org-drill-pending-entry-count ()
- (+ (length *org-drill-new-entries*)
- (length *org-drill-failed-entries*)
- (length *org-drill-mature-entries*)
- (length *org-drill-again-entries*)))
-
-
-(defun org-drill-maximum-duration-reached-p ()
- "Returns true if the current drill session has continued past its
-maximum duration."
- (and org-drill-maximum-duration
- *org-drill-start-time*
- (> (- (float-time (current-time)) *org-drill-start-time*)
- (* org-drill-maximum-duration 60))))
-
-
-(defun org-drill-maximum-item-count-reached-p ()
- "Returns true if the current drill session has reached the
-maximum number of items."
- (and org-drill-maximum-items-per-session
- (>= (length *org-drill-done-entries*)
- org-drill-maximum-items-per-session)))
-
-
-(defun org-drill-pop-next-pending-entry ()
- (cond
- ;; First priority is items we failed in a prior session.
- ((and *org-drill-failed-entries*
- (not (org-drill-maximum-item-count-reached-p))
- (not (org-drill-maximum-duration-reached-p)))
- (pop-random *org-drill-failed-entries*))
- ;; Next priority is newly added items, and items which
- ;; are not new and were not failed when they were last
- ;; reviewed.
- ((and (or *org-drill-new-entries*
- *org-drill-mature-entries*)
- (not (org-drill-maximum-item-count-reached-p))
- (not (org-drill-maximum-duration-reached-p)))
- (if (< (random (+ (length *org-drill-new-entries*)
- (length *org-drill-mature-entries*)))
- (length *org-drill-new-entries*))
- (pop-random *org-drill-new-entries*)
- ;; else
- (pop-random *org-drill-mature-entries*)))
- ;; After all the above are done, last priority is items
- ;; that were failed earlier THIS SESSION.
- (*org-drill-again-entries*
- (pop-random *org-drill-again-entries*))
- (t
- nil)))
-
-
-(defun org-drill-entries ()
- "Returns nil, t, or a list of markers representing entries that were
-'failed' and need to be presented again before the session ends."
- (block org-drill-entries
- (while (org-drill-entries-pending-p)
- (setq m (org-drill-pop-next-pending-entry))
- (unless m
- (error "Unexpectedly ran out of pending drill items"))
- (save-excursion
- (set-buffer (marker-buffer m))
- (goto-char m)
- (setq result (org-drill-entry))
- (cond
- ((null result)
- (message "Quit")
- (return-from org-drill-entries nil))
- ((eql result 'edit)
- (setq end-pos (point-marker))
- (return-from org-drill-entries nil))
- ((eql result 'skip)
- nil) ; skip this item
- (t
- (cond
- ((<= result org-drill-failure-quality)
- (push m *org-drill-again-entries*))
- (t
- (push m *org-drill-done-entries*)))))))))
-
-
-
-(defun org-drill-final-report ()
- (read-char-exclusive
- (format
- "%d items reviewed
-%d items awaiting review (%s, %s, %s)
-Session duration %s
-
-Recall of reviewed items:
- Excellent (5): %3d%% | Near miss (2): %3d%%
- Good (4): %3d%% | Failure (1): %3d%%
- Hard (3): %3d%% | Total failure (0): %3d%%
-
-Session finished. Press a key to continue..."
- (length *org-drill-done-entries*)
- (org-drill-pending-entry-count)
- (propertize
- (format "%d failed"
- (+ (length *org-drill-failed-entries*)
- (length *org-drill-again-entries*)))
- 'face `(:foreground ,org-drill-failed-count-color))
- (propertize
- (format "%d old"
- (length *org-drill-mature-entries*))
- 'face `(:foreground ,org-drill-mature-count-color))
- (propertize
- (format "%d new"
- (length *org-drill-new-entries*))
- 'face `(:foreground ,org-drill-new-count-color))
- (format-seconds "%h:%.2m:%.2s"
- (- (float-time (current-time)) *org-drill-start-time*))
- (round (* 100 (count 5 *org-drill-session-qualities*))
- (max 1 (length *org-drill-session-qualities*)))
- (round (* 100 (count 2 *org-drill-session-qualities*))
- (max 1 (length *org-drill-session-qualities*)))
- (round (* 100 (count 4 *org-drill-session-qualities*))
- (max 1 (length *org-drill-session-qualities*)))
- (round (* 100 (count 1 *org-drill-session-qualities*))
- (max 1 (length *org-drill-session-qualities*)))
- (round (* 100 (count 3 *org-drill-session-qualities*))
- (max 1 (length *org-drill-session-qualities*)))
- (round (* 100 (count 0 *org-drill-session-qualities*))
- (max 1 (length *org-drill-session-qualities*)))
- )))
-
-
-
-(defun org-drill (&optional scope)
- "Begin an interactive 'drill session'. The user is asked to
-review a series of topics (headers). Each topic is initially
-presented as a 'question', often with part of the topic content
-hidden. The user attempts to recall the hidden information or
-answer the question, then presses a key to reveal the answer. The
-user then rates his or her recall or performance on that
-topic. This rating information is used to reschedule the topic
-for future review using the `org-learn' library.
-
-Org-drill proceeds by:
-
-- Finding all topics (headings) in SCOPE which have either been
- used and rescheduled by org-learn before (i.e. the LEARN_DATA
- property is set), or which have a tag that matches
- `org-drill-question-tag'.
-
-- All matching topics which are either unscheduled, or are
- scheduled for the current date or a date in the past, are
- considered to be candidates for the drill session.
-
-- If `org-drill-maximum-items-per-session' is set, a random
- subset of these topics is presented. Otherwise, all of the
- eligible topics will be presented.
-
-SCOPE determines the scope in which to search for
-questions. It is passed to `org-map-entries', and can be any of:
-
-nil The current buffer, respecting the restriction if any.
- This is the default.
-tree The subtree started with the entry at point
-file The current buffer, without restriction
-file-with-archives
- The current buffer, and any archives associated with it
-agenda All agenda files
-agenda-with-archives
- All agenda files with any archive files associated with them
- (file1 file2 ...)
- If this is a list, all files in the list will be scanned."
-
- (interactive)
- (let ((entries nil)
- (failed-entries nil)
- (result nil)
- (results nil)
- (end-pos nil)
- (cnt 0))
- (block org-drill
- (setq *org-drill-done-entries* nil
- *org-drill-new-entries* nil
- *org-drill-mature-entries* nil
- *org-drill-failed-entries* nil
- *org-drill-again-entries* nil)
- (setq *org-drill-session-qualities* nil)
- (setq *org-drill-start-time* (float-time (current-time)))
- (unwind-protect
- (save-excursion
- (let ((org-trust-scanner-tags t))
- (org-map-entries
- (lambda ()
- (when (zerop (% (incf cnt) 50))
- (message "Processing drill items: %4d%s"
- (+ (length *org-drill-new-entries*)
- (length *org-drill-mature-entries*)
- (length *org-drill-failed-entries*))
- (make-string (ceiling cnt 50) ?.)))
- (when (org-drill-entry-due-p)
- (cond
- ((org-drill-entry-new-p)
- (push (point-marker) *org-drill-new-entries*))
- ((and (org-drill-entry-last-quality)
- (<= (org-drill-entry-last-quality)
- org-drill-failure-quality))
- (push (point-marker) *org-drill-failed-entries*))
- (t
- (push (point-marker) *org-drill-mature-entries*)))))
- (concat "+" org-drill-question-tag) scope))
- ;; Failed first, then random mix of old + new
- (setq entries (append (shuffle-list *org-drill-failed-entries*)
- (shuffle-list (append *org-drill-mature-entries*
- *org-drill-new-entries*))))
- (cond
- ((and (null *org-drill-new-entries*)
- (null *org-drill-failed-entries*)
- (null *org-drill-mature-entries*))
- (message "I did not find any pending drill items."))
- (t
- (org-drill-entries)
- (message "Drill session finished!"))))
- ;; (cond
- ;; ((null entries)
- ;; (message "I did not find any pending drill items."))
- ;; (t
- ;; (let ((again t))
- ;; (while again
- ;; (when (listp again)
- ;; (setq entries (shuffle-list again)))
- ;; (setq again (org-drill-entries entries))
- ;; (cond
- ;; ((null again)
- ;; (return-from org-drill nil))
- ;; ((eql t again)
- ;; (setq again nil))))
- ;; (message "Drill session finished!")
- ;; ))))
- (progn
- (dolist (m (append *org-drill-new-entries*
- *org-drill-failed-entries*
- *org-drill-again-entries*
- *org-drill-mature-entries*))
- (free-marker m)))))
- (cond
- (end-pos
- (switch-to-buffer (marker-buffer end-pos))
- (goto-char (marker-position end-pos))
- (message "Edit topic."))
- (t
- (org-drill-final-report)))))
-
-
-(defun org-drill-cram (&optional scope)
- "Run an interactive drill session in 'cram mode'. In cram mode,
-all drill items are considered to be due for review, unless they
-have been reviewed within the last `org-drill-cram-hours'
-hours."
- (interactive)
- (let ((*org-drill-cram-mode* t))
- (org-drill scope)))
-
-
-
-(add-hook 'org-mode-hook
- (lambda ()
- (if org-drill-use-visible-cloze-face-p
- (font-lock-add-keywords
- 'org-mode
- org-drill-cloze-keywords
- t))))
-
-
-
-(provide 'org-drill)
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-elisp-symbol.el b/.emacs.d/org-7.4/contrib/lisp/org-elisp-symbol.el
deleted file mode 100644
index b826467..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-elisp-symbol.el
+++ /dev/null
@@ -1,159 +0,0 @@
-;;; org-elisp-symbol.el --- Org links to emacs-lisp symbols
-;;
-;; Copyright 2007, 2008, 2009 Bastien Guerry
-;;
-;; Author: bzg AT altern DOT org
-;; Version: 0.2
-;; Keywords: org, remember, lisp
-;; URL: http://www.cognition.ens.fr/~guerry/u/org-elisp-symbol.el
-;;
-;; 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 3, 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, write to the Free Software
-;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-;;
-;;; Commentary:
-;;
-;; Org-mode already lets you store/insert links to emacs-lisp files,
-;; just like any other file. This package lets you precisely link to
-;; any emacs-lisp symbol and access useful information about the symbol.
-;;
-;; Here is the list of available properties when linking from a elisp-symbol:
-;;
-;; :name The symbol's name.
-;; :stype The symbol's type (commandp, function, etc.)
-;; :def The function used to set the symbol's value (defun, etc.)
-;; :keys The keys associated with the command.
-;; :args The arguments of the function.
-;; :docstring The docstring of the symbol.
-;; :doc The first line of the dostring.
-;; :comment A comment line just above the sexp, if any.
-;; :fixme A FIXME comment line just above the sexp, if any.
-;;
-;; Let's say we have a defun like this one:
-;;
-;; ;; FIXME update docstring
-;; (defun org-export-latex-lists ()
-;; "Convert lists to LaTeX."
-;; (goto-char (point-min))
-;; (while (re-search-forward org-export-latex-list-beginning-re nil t)
-;; (beginning-of-line)
-;; (insert (org-list-to-latex (org-list-parse-list t)) "\n")))
-;;
-;; And a remember template like:
-;;
-;; (setq org-remember-templates
-;; '((?s "* DEBUG `%:name' (%:args)\n\n%?\n\nFixme: %:fixme\n \
-;; Doc: \"%:doc\"\n\n%a")))
-;;
-;; Then M-x `org-remember' on this sexp will produce this buffer:
-;;
-;; =====================================================================
-;; * DEBUG `org-export-latex-lists' ()
-;;
-;; <== point
-;;
-;; Fixme: update the docstring
-;; Doc: "Convert lists to LaTeX."
-;;
-;; [[file:~/path/file.el::defun%20my-func][Function: my-func]]
-;; =====================================================================
-;;
-;; Put this file into your load-path and the following into your ~/.emacs:
-;; (require 'org-elisp-symbol)
-
-;;; Code:
-
-(provide 'org-elisp-symbol)
-
-(require 'org)
-
-(org-add-link-type "elisp-symbol" 'org-elisp-symbol-open)
-(add-hook 'org-store-link-functions 'org-elisp-symbol-store-link)
-
-(defun org-elisp-symbol-open (path)
- "Visit the emacs-lisp elisp-symbol at PATH."
- (let* ((search (when (string-match "::\\(.+\\)\\'" path)
- (match-string 1 path)))
- (path (substring path 0 (match-beginning 0))))
- (org-open-file path t nil search)))
-
-(defun org-elisp-symbol-store-link ()
- "Store a link to an emacs-lisp elisp-symbol."
- (when (eq major-mode 'emacs-lisp-mode)
- (save-excursion
- (or (looking-at "^(") (beginning-of-defun))
- (looking-at "^(\\([a-z]+\\) \\([^)\n ]+\\) ?\n?[ \t]*\\(?:(\\(.*\\))\\)?")
- (let* ((end (save-excursion
- (save-match-data
- (end-of-defun) (point))))
- (def (match-string 1))
- (name (match-string 2))
- (sym-name (intern-soft name))
- (stype (cond ((commandp sym-name) "Command")
- ((functionp sym-name) "Function")
- ((user-variable-p sym-name) "User variable")
- ((eq def "defvar") "Variable")
- ((eq def "defmacro") "Macro")
- (t "Symbol")))
- (args (if (match-string 3)
- (mapconcat (lambda (a) (unless (string-match "^&" a) a))
- (split-string (match-string 3)) " ")
- "no arg"))
- (docstring (cond ((functionp sym-name)
- (or (documentation sym-name)
- "[no documentation]"))
- ((string-match "[Vv]ariable" stype)
- (documentation-property sym-name
- 'variable-documentation))
- (t "no documentation")))
- (doc (and (string-match "^\\([^\n]+\\)$" docstring)
- (match-string 1 docstring)))
- (fixme (save-excursion
- (beginning-of-defun) (end-of-defun)
- (if (re-search-forward "^;+ ?FIXME[ :]*\\(.*\\)$" end t)
- (match-string 1) "nothing to fix")))
- (comment (save-excursion
- (beginning-of-defun) (end-of-defun)
- (if (re-search-forward "^;;+ ?\\(.*\\)$" end t)
- (match-string 1) "no comment")))
- keys keys-desc link description)
- (if (equal stype "Command")
- (setq keys (where-is-internal sym-name)
- keys-desc
- (if keys (mapconcat 'key-description keys " ") "none")))
- (setq link (concat "file:" (abbreviate-file-name buffer-file-name)
- "::" def " " name))
- (setq description (concat stype ": " name))
- (org-store-link-props
- :type "elisp-symbol"
- :link link
- :description description
- :def def
- :name name
- :stype stype
- :args args
- :keys keys-desc
- :docstring docstring
- :doc doc
- :fixme fixme
- :comment comment)))))
-
-(provide 'org-elisp-symbol)
-
-
-;;;;##########################################################################
-;;;; User Options, Variables
-;;;;##########################################################################
-
-
-;;; org-elisp-symbol.el ends here
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-eval-light.el b/.emacs.d/org-7.4/contrib/lisp/org-eval-light.el
deleted file mode 100644
index c571ea0..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-eval-light.el
+++ /dev/null
@@ -1,200 +0,0 @@
-;;; org-eval-light.el --- Display result of evaluating code in various languages (light)
-
-;; Copyright (C) 2008 Free Software Foundation, Inc.
-
-;; Author: Carsten Dominik <carsten at orgmode dot org>,
-;; Eric Schulte <schulte dot eric at gmail dot com>
-;; Keywords: outlines, hypermedia, calendar, wp, literate programming,
-;; reproducible research
-;; Homepage: http://orgmode.org
-;; Version: 0.04
-
-;; This file is not yet 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, 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; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; This file is based off of org-eval, with the following changes.
-;;
-;; 1) forms are only executed manually, (allowing for the execution of
-;; an entire subtree of forms)
-;; 2) use the org-mode style src blocks, rather than the muse style
-;; <code></code> blocks
-;; 3) forms are not replaced by their outputs, but rather the output
-;; is placed in the buffer immediately following the src block
-;; commented by `org-eval-light-make-region-example' (when
-;; evaluated with a prefix argument no output is placed in the
-;; buffer)
-;; 4) add defadvice to org-ctrl-c-ctrl-c so that when called inside of
-;; a source block it will call `org-eval-light-current-snippet'
-
-;;; Code:
-(require 'org)
-
-(defgroup org-eval-light nil
- "Options concerning including output from commands into the Org-mode buffer."
- :tag "Org Eval"
- :group 'org)
-
-(defvar org-eval-light-example-size-cutoff 10
- "The number of lines under which an example is considered
-'small', and is exported with the '^:' syntax instead of in a
-large example block")
-
-(defvar org-eval-light-regexp nil)
-
-(defun org-eval-light-set-interpreters (var value)
- (set-default var value)
- (setq org-eval-light-regexp
- (concat "#\\+begin_src \\("
- (mapconcat 'regexp-quote value "\\|")
- "\\)\\([^\000]+?\\)#\\+end_src")))
-
-(defcustom org-eval-light-interpreters '("lisp" "emacs-lisp" "ruby" "shell")
- "Interpreters allows for evaluation tags.
-This is a list of program names (as strings) that can evaluate code and
-insert the output into an Org-mode buffer. Valid choices are
-
-lisp Interpret Emacs Lisp code and display the result
-shell Pass command to the shell and display the result
-perl The perl interpreter
-python Thy python interpreter
-ruby The ruby interpreter"
- :group 'org-eval-light
- :set 'org-eval-light-set-interpreters
- :type '(set :greedy t
- (const "lisp")
- (const "emacs-lisp")
- (const "perl")
- (const "python")
- (const "ruby")
- (const "shell")))
-
-;;; functions
-(defun org-eval-light-inside-snippet ()
- (interactive)
- (save-excursion
- (let ((case-fold-search t)
- (start-re "^#\\+begin_src\\( \\([^ \t\n]+\\)\\)?.*\n")
- (end-re "\n#\\+end_src")
- (pos (point))
- beg end)
- (if (and (setq beg (re-search-backward start-re nil t))
- (setq end (re-search-forward end-re nil t))
- (<= beg pos) (>= end pos))
- t))))
-
-(defun org-eval-light-make-region-example (beg end)
- "Comment out region using either the '^:' or the BEGIN_EXAMPLE
-syntax based on the size of the region as compared to
-`org-eval-light-example-size-cutoff'."
- (interactive "*r")
- (let ((size (abs (- (line-number-at-pos end)
- (line-number-at-pos beg)))))
- (if (= size 0)
- (let ((result (buffer-substring beg end)))
- (delete-region beg end)
- (insert (concat ": " result)))
- (if (<= size org-eval-light-example-size-cutoff)
- (save-excursion
- (goto-char beg)
- (dotimes (n size)
- (move-beginning-of-line 1) (insert ": ") (forward-line 1)))
- (let ((result (buffer-substring beg end)))
- (delete-region beg end)
- (insert (concat "#+BEGIN_EXAMPLE\n" result "#+END_EXAMPLE\n")))))))
-
-(defun org-eval-light-current-snippet (&optional arg)
- "Execute the current #+begin_src #+end_src block, and dump the
-results into the buffer immediately following the src block,
-commented by `org-eval-light-make-region-example'."
- (interactive "P")
- (let ((line (org-current-line))
- (case-fold-search t)
- (info (org-edit-src-find-region-and-lang))
- beg end lang result)
- (setq beg (nth 0 info)
- end (nth 1 info)
- lang (nth 2 info))
- (unless (member lang org-eval-light-interpreters)
- (error "Language is not in `org-eval-light-interpreters': %s" lang))
- (goto-line line)
- (setq result (org-eval-light-code lang (buffer-substring beg end)))
- (unless arg
- (save-excursion
- (re-search-forward "^#\\+end_src" nil t) (open-line 1) (forward-char 2)
- (let ((beg (point))
- (end (progn (insert result)
- (point))))
- (message (format "from %S %S" beg end))
- (org-eval-light-make-region-example beg end))))))
-
-(defun org-eval-light-eval-subtree (&optional arg)
- "Replace EVAL snippets in the entire subtree."
- (interactive "P")
- (save-excursion
- (org-narrow-to-subtree)
- (goto-char (point-min))
- (while (re-search-forward org-eval-light-regexp nil t)
- (org-eval-light-current-snippet arg))
- (widen)))
-
-(defun org-eval-light-code (interpreter code)
- (cond
- ((member interpreter '("lisp" "emacs-lisp"))
- (org-eval-light-lisp (concat "(progn\n" code "\n)")))
- ((equal interpreter "shell")
- (shell-command-to-string code))
- ((member interpreter '("perl" "python" "ruby"))
- (org-eval-light-run (executable-find interpreter) code))
- (t (error "Cannot evaluate code type %s" interpreter))))
-
-(defun org-eval-light-lisp (form)
- "Evaluate the given form and return the result as a string."
- (require 'pp)
- (save-match-data
- (condition-case err
- (let ((object (eval (read form))))
- (cond
- ((stringp object) object)
- ((and (listp object)
- (not (eq object nil)))
- (let ((string (pp-to-string object)))
- (substring string 0 (1- (length string)))))
- ((numberp object)
- (number-to-string object))
- ((eq object nil) "")
- (t
- (pp-to-string object))))
- (error
- (org-display-warning (format "%s: Error evaluating %s: %s"
- "???" form err))
- "; INVALID LISP CODE"))))
-
-(defun org-eval-light-run (cmd code)
- (with-temp-buffer
- (insert code)
- (shell-command-on-region (point-min) (point-max) cmd nil 'replace)
- (buffer-string)))
-
-(defadvice org-ctrl-c-ctrl-c (around org-cc-eval-source activate)
- (if (org-eval-light-inside-snippet)
- (call-interactively 'org-eval-light-current-snippet)
- ad-do-it))
-
-(provide 'org-eval-light)
-;;; org-eval-light.el ends here \ No newline at end of file
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-eval.el b/.emacs.d/org-7.4/contrib/lisp/org-eval.el
deleted file mode 100644
index 0dd3ade..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-eval.el
+++ /dev/null
@@ -1,220 +0,0 @@
-;;; org-eval.el --- Display result of evaluating code in various languages
-;; Copyright (C) 2008 Free Software Foundation, Inc.
-;;
-;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: http://orgmode.org
-;; Version: 0.04
-;;
-;; This file is not yet 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, 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; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-;;
-;; This modules allows to include output from various commands into an
-;; Org-mode buffer, both for live display, and for export.
-;; This technique has been copied from emacs-wiki and Emacs Muse, and
-;; we try to make it work here in a way as similar as possible to
-;; Muse, so that people who move between both worlds don't need to learn
-;; new syntax.
-;;
-;; Basically it works like this:
-;;
-;; <lisp>(concat "aaa" "bbb")</lisp>
-;;
-;; will display "aaabbb" in the buffer and export like that as well.
-;; The leading lisp tag will also accept the attributes "markup" and
-;; "lang", to specify how the text should be formatted during export.
-;; For example,
-;;
-;; <lisp markup="src" lang="emacs-lisp"> .... </lisp>
-;;
-;; will format the result of the lisp form as if it was lisp source
-;; code. Internally, it will wrap the text into a
-;;
-;; #+begin_src emacs-lisp
-;; #+end_src
-;;
-;; structure so that the right things happen when the exporter is running.
-;;
-;; By default, only the <lisp> tag is turned on, but you can configure
-;; the variable `org-eval-interpreters' to add more interpreters like
-;; `perl', `python', or the `shell'.
-;;
-;; You can edit the code snippets with "C-c '" (org-edit-src-code).
-;;
-;; Please note that this mechanism is potentially dangerous, because it
-;; executes code that you don't even see. This gives you great power,
-;; but also enough rope to hang yourself. And, it gives your friends
-;; who send you Org files plenty of opportunity for good and bad jokes.
-;; This is also why this module is not turned on by default, but only
-;; available as a contributed package.
-;;
-;;
-;;
-(require 'org)
-
-;;; Customization
-
-(defgroup org-eval nil
- "Options concerning including output from commands into the Org-mode buffer."
- :tag "Org Eval"
- :group 'org)
-
-(defface org-eval
- (org-compatible-face nil
- '((((class color grayscale) (min-colors 88) (background light))
- (:foreground "grey40"))
- (((class color grayscale) (min-colors 88) (background dark))
- (:foreground "grey60"))
- (((class color) (min-colors 8) (background light))
- (:foreground "green"))
- (((class color) (min-colors 8) (background dark))
- (:foreground "yellow"))))
- "Face for command output that is included into an Org-mode buffer."
- :group 'org-eval
- :group 'org-faces
- :version "22.1")
-
-(defvar org-eval-regexp nil)
-
-(defun org-eval-set-interpreters (var value)
- (set-default var value)
- (setq org-eval-regexp
- (concat "<\\("
- (mapconcat 'regexp-quote value "\\|")
- "\\)"
- "\\([^>]\\{0,50\\}?\\)>"
- "\\([^\000]+?\\)</\\1>")))
-
-(defcustom org-eval-interpreters '("lisp")
- "Interpreters allows for evaluation tags.
-This is a list of program names (as strings) that can evaluate code and
-insert the output into an Org-mode buffer. Valid choices are
-
-lisp Interpret Emacs Lisp code and display the result
-shell Pass command to the shell and display the result
-perl The perl interpreter
-python Thy python interpreter
-ruby The ruby interpreter"
- :group 'org-eval
- :set 'org-eval-set-interpreters
- :type '(set :greedy t
- (const "lisp")
- (const "perl")
- (const "python")
- (const "ruby")
- (const "shell")))
-
-(defun org-eval-handle-snippets (limit &optional replace)
- "Evaluate code snippets and display the results as display property.
-When REPLACE is non-nil, replace the code region with the result (used
-for export)."
- (let (a)
- (while (setq a (text-property-any (point) (or limit (point-max))
- 'org-eval t))
- (remove-text-properties
- a (next-single-property-change a 'org-eval nil limit)
- '(display t intangible t org-eval t))))
- (while (re-search-forward org-eval-regexp limit t)
- (let* ((beg (match-beginning 0))
- (end (match-end 0))
- (kind (match-string 1))
- (attr (match-string 2))
- (code (match-string 3))
- (value (org-eval-code kind code))
- markup lang)
- (if replace
- (progn
- (setq attr (save-match-data (org-eval-get-attributes attr))
- markup (cdr (assoc "markup" attr))
- lang (cdr (assoc "lang" attr)))
- (replace-match
- (concat (if markup (format "#+BEGIN_%s" (upcase markup)))
- (if (and markup (equal (downcase markup) "src"))
- (concat " " (or lang "fundamental")))
- "\n"
- value
- (if markup (format "\n#+END_%s\n" (upcase markup))))
- t t))
- (add-text-properties
- beg end
- (list 'display value 'intangible t 'font-lock-multiline t
- 'face 'org-eval
- 'org-eval t))))))
-
-(defun org-eval-replace-snippts ()
- "Replace EVAL snippets in the entire buffer.
-This should go into the `org-export-preprocess-hook'."
- (goto-char (point-min))
- (org-eval-handle-snippets nil 'replace))
-
-(add-hook 'org-export-preprocess-hook 'org-eval-replace-snippts)
-(add-hook 'org-font-lock-hook 'org-eval-handle-snippets)
-
-(defun org-eval-get-attributes (str)
- (let ((start 0) key value rtn)
- (while (string-match "\\<\\([a-zA-Z]+\\)\\>=\"\\([^\"]+\\)\"" str start)
- (setq key (match-string 1 str)
- value (match-string 2 str)
- start (match-end 0))
- (push (cons key value) rtn))
- rtn))
-
-(defun org-eval-code (interpreter code)
- (cond
- ((equal interpreter "lisp")
- (org-eval-lisp (concat "(progn\n" code "\n)")))
- ((equal interpreter "shell")
- (shell-command-to-string code))
- ((member interpreter '("perl" "python" "ruby"))
- (org-eval-run (executable-find interpreter) code))
- (t (error "Cannot evaluate code type %s" interpreter))))
-
-(defun org-eval-lisp (form)
- "Evaluate the given form and return the result as a string."
- (require 'pp)
- (save-match-data
- (condition-case err
- (let ((object (eval (read form))))
- (cond
- ((stringp object) object)
- ((and (listp object)
- (not (eq object nil)))
- (let ((string (pp-to-string object)))
- (substring string 0 (1- (length string)))))
- ((numberp object)
- (number-to-string object))
- ((eq object nil) "")
- (t
- (pp-to-string object))))
- (error
- (org-display-warning (format "%s: Error evaluating %s: %s"
- "???" form err))
- "; INVALID LISP CODE"))))
-
-(defun org-eval-run (cmd code)
- (with-temp-buffer
- (insert code)
- (shell-command-on-region (point-min) (point-max) cmd nil 'replace)
- (buffer-string)))
-
-(provide 'org-eval)
-
-;;; org-eval.el ends here
-
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-exp-bibtex.el b/.emacs.d/org-7.4/contrib/lisp/org-exp-bibtex.el
deleted file mode 100644
index ab6a6b0..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-exp-bibtex.el
+++ /dev/null
@@ -1,155 +0,0 @@
-;;; org-exp-bibtex.el --- Export bibtex fragments
-
-;; Copyright (C) 2009 Taru Karttunen
-
-;; Author: Taru Karttunen <taruti@taruti.net >
-
-;; This file is not currently part of GNU Emacs.
-
-;; 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 ; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-;;
-;; This is an utility to handle BibTeX export to both LaTeX and html
-;; exports. It uses the bibtex2html software from
-;; http://www.lri.fr/~filliatr/bibtex2html/
-;;
-;; The usage is as follows:
-;; #+BIBLIOGRAPHY: bibfilebasename stylename optional-options
-;; e.g. given foo.bib and using style plain:
-;; #+BIBLIOGRAPHY: foo plain option:-d
-;;
-;; Optional options are of the form:
-;;
-;; option:-foobar pass '-foobar' to bibtex2html
-;; e.g.
-;; option:-d sort by date.
-;; option:-a sort as BibTeX (usually by author) *default*
-;; option:-u unsorted i.e. same order as in .bib file
-;; option:-r reverse the sort.
-;; see the bibtex2html man page for more. Multiple options can be combined like:
-;; option:-d option:-r
-;;
-;; Limiting to only the entries cited in the document:
-;; limit:t
-
-;; For LaTeX export this simply inserts the lines
-;; \bibliographystyle{plain}
-;; \bibliography{foo}
-;; into the tex-file when exporting.
-
-;; For Html export it:
-;; 1) converts all \cite{foo} to links to the bibliography
-;; 2) creates a foo.html and foo_bib.html
-;; 3) includes the contents of foo.html in the exported html file
-
-(require 'org)
-(require 'org-exp)
-(defun org-export-bibtex-preprocess ()
- "Export all BibTeX."
- (interactive)
- (save-window-excursion
- (setq oebp-cite-plist '())
-
- ;; Convert #+BIBLIOGRAPHY: name style
- (goto-char (point-min))
- (while (re-search-forward "^#\\+BIBLIOGRAPHY:[ \t]+\\(\\S-+\\)[ \t]+\\(\\S-+\\)\\([^\r\n]*\\)" nil t)
- (let ((file (match-string 1))
- (style (match-string 2))
- (opt (org-exp-bibtex-options-to-plist (match-string 3))))
- (replace-match
- (cond
- (htmlp ;; We are exporting to HTML
- (let (extra-args cite-list end-hook tmp-files)
- (dolist (elt opt)
- (when (equal "option" (car elt))
- (setq extra-args (cons (cdr elt) extra-args))))
-
-
- (when (assoc "limit" opt) ;; Limit is true - collect references
- (org-exp-bibtex-docites (lambda ()
- (dolist (c (org-split-string (match-string 1) ","))
- (add-to-list 'cite-list c))))
-;; (message "cites: %s" cite-list)
- (let ((tmp (make-temp-file "org-exp-bibtex")))
- (with-temp-file tmp (dolist (i cite-list) (insert (concat i "\n"))))
- (setq tmp-files (cons tmp tmp-files))
- (setq extra-args (append extra-args `("-citefile" ,tmp)))))
-
- (when (not (eq 0 (apply 'call-process (append '("bibtex2html" nil nil nil)
- `("-a" "--nodoc" "--style" ,style "--no-header")
- extra-args
- (list (concat file ".bib"))))))
- (error "Executing bibtex2html failed"))
-
- (dolist (f tmp-files) (delete-file f)))
-
- (with-temp-buffer
- (save-match-data
- (insert-file-contents (concat file ".html"))
- (goto-char (point-min))
- (while (re-search-forward "a name=\"\\(\\w+\\)\">\\(\\w+\\)" nil t)
- (setq oebp-cite-plist (cons (cons (match-string 1) (match-string 2)) oebp-cite-plist)))
- (goto-char (point-min))
- (while (re-search-forward "<hr>" nil t)
- (replace-match "<hr/>" t t))
- (concat "\n#+BEGIN_HTML\n<div id=\"bibliography\">\n" (buffer-string) "\n</div>\n#+END_HTML\n"))))
- (latexp ;; Latex export
- (concat "\n#+LATEX: \\bibliographystyle{" style "}"
- "\n#+LATEX: \\bibliography{" file "}\n"))) t t)))
-
-
- ;; Convert cites to links in html
- (when htmlp
- ;; Split citation commands with multiple keys
- (org-exp-bibtex-docites
- (lambda ()
- (let ((keys (save-match-data (org-split-string (match-string 1) ","))))
- (when (> (length keys) 1)
- (replace-match (mapconcat (lambda (k) (format "\\cite{%s}" k)) keys "")
- t t)))))
- ;; Replace the citation commands with links
- (org-exp-bibtex-docites
- (lambda () (let* ((cn (match-string 1))
- (cv (assoc cn oebp-cite-plist)))
-;; (message "L: %s" (concat "\[_{}[[" cn "][" (if cv (cdr cv) cn) "]]\]"))
- (replace-match (concat "\[_{}[[#" cn "][" (if cv (cdr cv) cn) "]]\]")) t t))))
-
-
-))
-
-(defun org-exp-bibtex-docites (fun)
- (save-excursion
- (save-match-data
- (goto-char (point-min))
- (when htmlp
- (while (re-search-forward "\\\\cite{\\([^}\n]+\\)}" nil t)
- (apply fun nil))))))
-
-
-(defun org-exp-bibtex-options-to-plist (options)
- (save-match-data
- (flet ((f (o) (let ((s (split-string o ":"))) (cons (nth 0 s) (nth 1 s)))))
- (mapcar 'f (split-string options nil t)))))
-
-
-
-
-(add-hook 'org-export-preprocess-hook 'org-export-bibtex-preprocess)
-
-(provide 'org-exp-bibtex)
-
-;;; org-exp-bibtex.el ends here
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-expiry.el b/.emacs.d/org-7.4/contrib/lisp/org-expiry.el
deleted file mode 100644
index 4a49399..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-expiry.el
+++ /dev/null
@@ -1,346 +0,0 @@
-;;; org-expiry.el --- expiry mechanism for Org entries
-;;
-;; Copyright 2007 2008 Bastien Guerry
-;;
-;; Author: bzg AT altern DOT org
-;; Version: 0.2
-;; Keywords: org expiry
-;; URL: http://www.cognition.ens.fr/~guerry/u/org-expiry.el
-;;
-;; 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 3, 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, write to the Free Software
-;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-;;
-;;; Commentary:
-;;
-;; This gives you a chance to get rid of old entries in your Org files
-;; by expiring them.
-;;
-;; By default, entries that have no EXPIRY property are considered to be
-;; new (i.e. 0 day old) and only entries older than one year go to the
-;; expiry process, which consist in adding the ARCHIVE tag. None of
-;; your tasks will be deleted with the default settings.
-;;
-;; When does an entry expires?
-;;
-;; Consider this entry:
-;;
-;; * Stop watching TV
-;; :PROPERTIES:
-;; :CREATED: <2008-01-07 lun 08:01>
-;; :EXPIRY: <2008-01-09 08:01>
-;; :END:
-;;
-;; This entry will expire on the 9th, january 2008.
-
-;; * Stop watching TV
-;; :PROPERTIES:
-;; :CREATED: <2008-01-07 lun 08:01>
-;; :EXPIRY: +1w
-;; :END:
-;;
-;; This entry will expire on the 14th, january 2008, one week after its
-;; creation date.
-;;
-;; What happen when an entry is expired? Nothing until you explicitely
-;; M-x org-expiry-process-entries When doing this, org-expiry will check
-;; for expired entries and request permission to process them.
-;;
-;; Processing an expired entries means calling the function associated
-;; with `org-expiry-handler-function'; the default is to add the tag
-;; :ARCHIVE:, but you can also add a EXPIRED keyword or even archive
-;; the subtree.
-;;
-;; Is this useful? Well, when you're in a brainstorming session, it
-;; might be useful to know about the creation date of an entry, and be
-;; able to archive those entries that are more than xxx days/weeks old.
-;;
-;; When you're in such a session, you can insinuate org-expiry like
-;; this: M-x org-expiry-insinuate
-;;
-;; Then, each time you're pressing M-RET to insert an item, the CREATION
-;; property will be automatically added. Same when you're scheduling or
-;; deadlining items. You can deinsinuate: M-x org-expiry-deinsinuate
-
-;;; Code:
-
-;;; User variables:
-
-(defgroup org-expiry nil
- "Org expiry process."
- :tag "Org Expiry"
- :group 'org)
-
-(defcustom org-expiry-created-property-name "CREATED"
- "The name of the property for setting the creation date."
- :type 'string
- :group 'org-expiry)
-
-(defcustom org-expiry-expiry-property-name "EXPIRY"
- "The name of the property for setting the expiry date/delay."
- :type 'string
- :group 'org-expiry)
-
-(defcustom org-expiry-keyword "EXPIRED"
- "The default keyword for `org-expiry-add-keyword'."
- :type 'string
- :group 'org-expiry)
-
-(defcustom org-expiry-wait "+1y"
- "Time span between the creation date and the expiry.
-The default value for this variable (\"+1y\") means that entries
-will expire if there are at least one year old.
-
-If the expiry delay cannot be retrieved from the entry or the
-subtree above, the expiry process compares the expiry delay with
-`org-expiry-wait'. This can be either an ISO date or a relative
-time specification. See `org-read-date' for details."
- :type 'string
- :group 'org-expiry)
-
-(defcustom org-expiry-created-date "+0d"
- "The default creation date.
-The default value of this variable (\"+0d\") means that entries
-without a creation date will be handled as if they were created
-today.
-
-If the creation date cannot be retrieved from the entry or the
-subtree above, the expiry process will compare the expiry delay
-with this date. This can be either an ISO date or a relative
-time specification. See `org-read-date' for details on relative
-time specifications."
- :type 'string
- :group 'org-expiry)
-
-(defcustom org-expiry-handler-function 'org-toggle-archive-tag
- "Function to process expired entries.
-Possible candidates for this function are:
-
-`org-toggle-archive-tag'
-`org-expiry-add-keyword'
-`org-expiry-archive-subtree'"
- :type 'function
- :group 'org-expiry)
-
-(defcustom org-expiry-confirm-flag t
- "Non-nil means confirm expiration process."
- :type '(choice
- (const :tag "Always require confirmation" t)
- (const :tag "Do not require confirmation" nil)
- (const :tag "Require confirmation in interactive expiry process"
- interactive))
- :group 'org-expiry)
-
-(defcustom org-expiry-advised-functions
- '(org-scheduled org-deadline org-time-stamp)
- "A list of advised functions.
-`org-expiry-insinuate' will activate the expiry advice for these
-functions. `org-expiry-deinsinuate' will deactivate them."
- :type 'boolean
- :group 'list)
-
-;;; Advices and insinuation:
-
-(defadvice org-schedule (after org-schedule-update-created)
- "Update the creation-date property when calling `org-schedule'."
- (org-expiry-insert-created))
-
-(defadvice org-deadline (after org-deadline-update-created)
- "Update the creation-date property when calling `org-deadline'."
- (org-expiry-insert-created))
-
-(defadvice org-time-stamp (after org-time-stamp-update-created)
- "Update the creation-date property when calling `org-time-stamp'."
- (org-expiry-insert-created))
-
-(defun org-expiry-insinuate (&optional arg)
- "Add hooks and activate advices for org-expiry.
-If ARG, also add a hook to `before-save-hook' in `org-mode' and
-restart `org-mode' if necessary."
- (interactive "P")
- (ad-activate 'org-schedule)
- (ad-activate 'org-time-stamp)
- (ad-activate 'org-deadline)
- (add-hook 'org-insert-heading-hook 'org-expiry-insert-created)
- (add-hook 'org-after-todo-state-change-hook 'org-expiry-insert-created)
- (add-hook 'org-after-tags-change-hook 'org-expiry-insert-created)
- (when arg
- (add-hook 'org-mode-hook
- (lambda() (add-hook 'before-save-hook
- 'org-expiry-process-entries t t)))
- ;; need this to refresh org-mode hooks
- (when (org-mode-p)
- (org-mode)
- (if (interactive-p)
- (message "Org-expiry insinuated, `org-mode' restarted.")))))
-
-(defun org-expiry-deinsinuate (&optional arg)
- "Remove hooks and deactivate advices for org-expiry.
-If ARG, also remove org-expiry hook in Org's `before-save-hook'
-and restart `org-mode' if necessary."
- (interactive "P")
- (ad-deactivate 'org-schedule)
- (ad-deactivate 'org-time-stamp)
- (ad-deactivate 'org-deadline)
- (remove-hook 'org-insert-heading-hook 'org-expiry-insert-created)
- (remove-hook 'org-after-todo-state-change-hook 'org-expiry-insert-created)
- (remove-hook 'org-after-tags-change-hook 'org-expiry-insert-created)
- (remove-hook 'org-mode-hook
- (lambda() (add-hook 'before-save-hook
- 'org-expiry-process-entries t t)))
- (when arg
- ;; need this to refresh org-mode hooks
- (when (org-mode-p)
- (org-mode)
- (if (interactive-p)
- (message "Org-expiry de-insinuated, `org-mode' restarted.")))))
-
-;;; org-expiry-expired-p:
-
-(defun org-expiry-expired-p ()
- "Check if the entry at point is expired.
-Return nil if the entry is not expired. Otherwise return the
-amount of time between today and the expiry date.
-
-If there is no creation date, use `org-expiry-created-date'.
-If there is no expiry date, use `org-expiry-expiry-date'."
- (let* ((ex-prop org-expiry-expiry-property-name)
- (cr-prop org-expiry-created-property-name)
- (ct (current-time))
- (cr (org-read-date nil t (or (org-entry-get (point) cr-prop t) "+0d")))
- (ex-field (or (org-entry-get (point) ex-prop t) org-expiry-wait))
- (ex (if (string-match "^[ \t]?[+-]" ex-field)
- (time-add cr (time-subtract (org-read-date nil t ex-field) ct))
- (org-read-date nil t ex-field))))
- (if (time-less-p ex ct)
- (time-subtract ct ex))))
-
-;;; Expire an entry or a region/buffer:
-
-(defun org-expiry-process-entry (&optional force)
- "Call `org-expiry-handler-function' on entry.
-If FORCE is non-nil, don't require confirmation from the user.
-Otherwise rely on `org-expiry-confirm-flag' to decide."
- (interactive "P")
- (save-excursion
- (when (interactive-p) (org-reveal))
- (when (org-expiry-expired-p)
- (org-back-to-heading)
- (looking-at org-complex-heading-regexp)
- (let* ((ov (make-overlay (point) (match-end 0)))
- (e (org-expiry-expired-p))
- (d (time-to-number-of-days e)))
- (overlay-put ov 'face 'secondary-selection)
- (if (or force
- (null org-expiry-confirm-flag)
- (and (eq org-expiry-confirm-flag 'interactive)
- (not (interactive)))
- (and org-expiry-confirm-flag
- (y-or-n-p (format "Entry expired by %d days. Process? " d))))
- (funcall 'org-expiry-handler-function))
- (delete-overlay ov)))))
-
-(defun org-expiry-process-entries (beg end)
- "Process all expired entries between BEG and END.
-The expiry process will run the function defined by
-`org-expiry-handler-functions'."
- (interactive "r")
- (save-excursion
- (let ((beg (if (org-region-active-p)
- (region-beginning) (point-min)))
- (end (if (org-region-active-p)
- (region-end) (point-max))))
- (goto-char beg)
- (let ((expired 0) (processed 0))
- (while (and (outline-next-heading) (< (point) end))
- (when (org-expiry-expired-p)
- (setq expired (1+ expired))
- (if (if (interactive-p)
- (call-interactively 'org-expiry-process-entry)
- (org-expiry-process-entry))
- (setq processed (1+ processed)))))
- (if (equal expired 0)
- (message "No expired entry")
- (message "Processed %d on %d expired entries"
- processed expired))))))
-
-;;; Insert created/expiry property:
-
-(defun org-expiry-insert-created (&optional arg)
- "Insert or update a property with the creation date.
-If ARG, always update it. With one `C-u' prefix, silently update
-to today's date. With two `C-u' prefixes, prompt the user for to
-update the date."
- (interactive "P")
- (let* ((d (org-entry-get (point) org-expiry-created-property-name))
- d-time d-hour)
- (when (or (null d) arg)
- ;; update if no date or non-nil prefix argument
- ;; FIXME Use `org-time-string-to-time'
- (setq d-time (if d (apply 'encode-time (org-parse-time-string d))
- (current-time)))
- (setq d-hour (format-time-string "%H:%M" d-time))
- (save-excursion
- (org-entry-put
- (point) org-expiry-created-property-name
- ;; two C-u prefixes will call org-read-date
- (if (equal arg '(16))
- (concat "<" (org-read-date
- nil nil nil nil d-time d-hour) ">")
- (format-time-string (cdr org-time-stamp-formats))))))))
-
-(defun org-expiry-insert-expiry (&optional today)
- "Insert a property with the expiry date.
-With one `C-u' prefix, don't prompt interactively for the date
-and insert today's date."
- (interactive "P")
- (let* ((d (org-entry-get (point) org-expiry-expiry-property-name))
- d-time d-hour)
- (setq d-time (if d (apply 'encode-time (org-parse-time-string d))
- (current-time)))
- (setq d-hour (format-time-string "%H:%M" d-time))
- (save-excursion
- (org-entry-put
- (point) org-expiry-expiry-property-name
- (if today (format-time-string (cdr org-time-stamp-formats))
- (concat "<" (org-read-date
- nil nil nil nil d-time d-hour) ">"))))))
-
-;;; Functions to process expired entries:
-
-(defun org-expiry-archive-subtree ()
- "Archive the entry at point if it is expired."
- (interactive)
- (save-excursion
- (if (org-expiry-expired-p)
- (org-archive-subtree)
- (if (interactive-p)
- (message "Entry at point is not expired.")))))
-
-(defun org-expiry-add-keyword (&optional keyword)
- "Add KEYWORD to the entry at point if it is expired."
- (interactive "sKeyword: ")
- (if (or (member keyword org-todo-keywords-1)
- (setq keyword org-expiry-keyword))
- (save-excursion
- (if (org-expiry-expired-p)
- (org-todo keyword)
- (if (interactive-p)
- (message "Entry at point is not expired."))))
- (error "\"%s\" is not a to-do keyword in this buffer" keyword)))
-
-;; FIXME what about using org-refile ?
-
-(provide 'org-expiry)
-
-;;; org-expiry.el ends here
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-export-generic.el b/.emacs.d/org-7.4/contrib/lisp/org-export-generic.el
deleted file mode 100644
index f8e8c4a..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-export-generic.el
+++ /dev/null
@@ -1,1385 +0,0 @@
-;; org-export-generic.el --- Export frameworg with custom backends
-
-;; Copyright (C) 2009 Free Software Foundation, Inc.
-
-;; Author: Wes Hardaker <hardaker at users dot sourceforge dot net>
-;; Keywords: outlines, hypermedia, calendar, wp, export
-;; Homepage: http://orgmode.org
-;; Version: 6.25trans
-;; Acks: Much of this code was stolen form the ascii export from Carsten
-;;
-;; This file is not yet 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/>.
-;;
-;; ----------------------------------------------------------------------
-;;
-;; OVERVIEW
-;;
-;; org-export-generic is basically a simple translation system that
-;; knows how to parse at least most of a .org buffer and then add
-;; various formatting prefixes before and after each section type. It
-;; does this by examining a property list stored in org-generic-alist.
-;; You can dynamically add propety lists of your own using the
-;; org-set-generic-type function:
-;;
-;; (org-set-generic-type
-;; "really-basic-text"
-;; '(:file-suffix ".txt"
-;; :key-binding ?R
-;;
-;; :title-format "=== %s ===\n"
-;; :body-header-section-numbers t
-;; :body-header-section-number-format "%s) "
-;; :body-section-header-prefix "\n"
-;; :body-section-header-suffix "\n"
-;; :body-line-format " %s\n"
-;; :body-line-wrap 75
-;; ))
-;;
-;; Note: Upper case key-bindings are reserved for your use. Lower
-;; case key bindings may conflict with future export-generic
-;; publications.
-;;
-;; Then run org-export (ctrl-c ctrl-e) and select generic or run
-;; org-export-generic. You'll then be prompted with a list of export
-;; types to choose from which will include your new type assigned to
-;; the key "r".
-;;
-;; ----------------------------------------------------------------------
-;;
-;; TODO (non-ordered)
-;; * handle function references
-;; * handle other types of multi-complex-listy-things to do
-;; ideas: (t ?- "%s" ?-)
-;; * handle indent specifiers better
-;; ideas: (4 ?\ "%s")
-;; * need flag to remove indents from body text
-;; * handle links
-;; * handle internationalization strings better
-;; * date/author/etc needs improvment (internationalization too)
-;; * allow specifying of section ordering
-;; ideas: :ordering ("header" "toc" "body" "footer")
-;; ^ matches current hard coded ordering
-;; * err, actually *do* a footer
-;; * deal with usage of org globals
-;; *** should we even consider them, or let the per-section specifiers do it
-;; *** answer: remove; mostly removed now
-;; * deal with interactive support for picking a export specifier label
-;; * char specifiers that need extra length because of formatting
-;; idea: (?- 4) for 4-longer
-;; * centering specifier
-;; idea: ('center " -- %s -- ")
-;; * remove more of the unneeded export-to-ascii copy code
-;; * tags
-;; *** supported now, but need separate format per tag
-;; *** allow different open/closing prefixes
-;; * properties
-;; * drawers
-;; * oh my
-;; * optmization (many plist extracts should be in let vars)
-;; * define defcustom spec for the specifier list
-;; * fonts: at least monospace is not handled at all here.
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-
-(require 'org-exp)
-(require 'assoc)
-
-(defgroup org-export-generic nil
- "Options specific for ASCII export of Org-mode files."
- :tag "Org Export ASCII"
- :group 'org-export)
-
-(defcustom org-export-generic-links-to-notes t
- "Non-nil means convert links to notes before the next headline.
-When nil, the link will be exported in place. If the line becomes long
-in this way, it will be wrapped."
- :group 'org-export-generic
- :type 'boolean)
-
-
-(defvar org-generic-current-indentation nil) ; For communication
-
-(defvar org-generic-alist
- '(
- ;;
- ;; generic DEMO exporter
- ;;
- ;; (this tries to use every specifier for demo purposes)
- ;;
- ("demo"
- :file-suffix ".txt"
- :key-binding ?d
-
- :header-prefix "<header>\n"
- :header-suffix "</header>\n"
-
- :author-export t
- :tags-export t
-
- :drawers-export t
-
-
- :title-prefix ?=
- :title-format "<h1>%s</h1>\n"
- :title-suffix ?=
-
- :date-export t
- :date-prefix "<date>"
- :date-format "<br /><b>Date:</b> <i>%s</i><br />"
- :date-suffix "</date>\n\n"
-
- :toc-export t
- :toc-header-prefix "<tocname>\n"
- :toc-header-format "__%s__\n"
- :toc-header-suffix "</tocname>\n"
-
- :toc-prefix "<toc>\n"
- :toc-suffix "</toc>\n"
-
- :toc-section-numbers t
- :toc-section-number-format "\#(%s) "
- :toc-format "--%s--"
- :toc-format-with-todo "!!%s!!\n"
- :toc-indent-char ?\
- :toc-indent-depth 4
-
- :toc-tags-export t
- :toc-tags-prefix " <tags>"
- :toc-tags-format "*%s*"
- :toc-tags-suffix "</tags>\n"
- :toc-tags-none-string "\n"
-
- :body-header-section-numbers 3 ; t = all, nil = none
-
- ; lists indicate different things per level
- ; list contents or straight value can either be a
- ; ?x char reference for printing strings that match the header len
- ; "" string to print directly
- :body-section-header-prefix ("<h1>" "<h2>" "<h3>"
- "<h4>" "<h5>" "<h6>")
- :body-section-header-format "%s"
- :body-section-header-suffix ("</h1>\n" "</h2>\n" "</h3>\n"
- "</h4>\n" "</h5>\n" "</h6>\n")
-
- :timestamps-export t
- :priorities-export t
- :todo-keywords-export t
-
- :body-tags-export t
- :body-tags-prefix " <tags>"
- :body-tags-suffix "</tags>\n"
-
- ; section prefixes/suffixes can be direct strings or lists as well
- :body-section-prefix "<secprefix>\n"
- :body-section-suffix "</secsuffix>\n"
-; :body-section-prefix ("<sec1>\n" "<sec2>\n" "<sec3>\n")
-; :body-section-suffix ("</sec1>\n" "</sec2>\n" "</sec3>\n")
-
-
- ; if preformated text should be included (eg, : prefixed)
- :body-line-export-preformated t
- :body-line-fixed-prefix "<pre>\n"
- :body-line-fixed-suffix "\n</pre>\n"
- :body-line-fixed-format "%s\n"
-
-
- :body-list-prefix "<list>\n"
- :body-list-suffix "</list>\n"
- :body-list-format "<li>%s</li>\n"
-
- :body-number-list-prefix "<ol>\n"
- :body-number-list-suffix "</ol>\n"
- :body-number-list-format "<li>%s</li>\n"
- :body-number-list-leave-number t
-
- :body-list-checkbox-todo "<checkbox type=\"todo\">"
- :body-list-checkbox-todo-end "</checkbox (todo)>"
- :body-list-checkbox-done "<checkbox type=\"done\">"
- :body-list-checkbox-done-end "</checkbox (done)>"
- :body-list-checkbox-half "<checkbox type=\"half\">"
- :body-list-checkbox-half-end "</checkbox (half)>"
-
-
-
-
- ; other body lines
- :body-line-format "%s"
- :body-line-wrap 60 ; wrap at 60 chars
-
- ; print above and below all body parts
- :body-text-prefix "<p>\n"
- :body-text-suffix "</p>\n"
-
- )
-
- ;;
- ;; ascii exporter
- ;;
- ;; (close to the original ascii specifier)
- ;;
- ("ascii"
- :file-suffix ".txt"
- :key-binding ?a
-
- :header-prefix ""
- :header-suffix ""
-
- :title-prefix ?=
- :title-format "%s\n"
- :title-suffix ?=
-
- :date-export t
- :date-prefix ""
- :date-format "Date: %s\n"
- :date-suffix ""
-
- :toc-header-prefix ""
- :toc-header-format "%s\n"
- :toc-header-suffix ?=
-
- :toc-export t
- :toc-section-numbers t
- :toc-section-number-format "%s "
- :toc-format "%s\n"
- :toc-format-with-todo "%s (*)\n"
- :toc-indent-char ?\
- :toc-indent-depth 4
-
- :body-header-section-numbers 3
- :body-section-prefix "\n"
-
-; :body-section-header-prefix "\n"
-; :body-section-header-format "%s\n"
-; :body-section-header-suffix (?\$ ?\# ?^ ?\~ ?\= ?\-)
-
- :body-section-header-prefix ("" "" "" "* " " + " " - ")
- :body-section-header-format "%s\n"
- :body-section-header-suffix (?~ ?= ?- "\n" "\n" "\n")
-
-; :body-section-marker-prefix ""
-; :body-section-marker-chars (?\$ ?\# ?^ ?\~ ?\= ?\-)
-; :body-section-marker-suffix "\n"
-
- :body-line-export-preformated t
- :body-line-format "%s\n"
- :body-line-wrap 75
-
-; :body-text-prefix "<t>\n"
-; :body-text-suffix "</t>\n"
-
-
- :body-bullet-list-prefix (?* ?+ ?-)
-; :body-bullet-list-suffix (?* ?+ ?-)
- )
-
- ;;
- ;; wikipedia
- ;;
- ("wikipedia"
- :file-suffix ".txt"
- :key-binding ?w
-
- :header-prefix ""
- :header-suffix ""
-
- :title-format "= %s =\n"
-
- :date-export nil
-
- :toc-export nil
-
- :body-header-section-numbers nil
- :body-section-prefix "\n"
-
- :body-section-header-prefix ("= " "== " "=== "
- "==== " "===== " "====== ")
- :body-section-header-suffix (" =\n\n" " ==\n\n" " ===\n\n"
- " ====\n\n" " =====\n\n" " ======\n\n")
-
- :body-line-export-preformated t ;; yes/no/maybe???
- :body-line-format "%s\n"
- :body-line-wrap 75
-
- :body-line-fixed-format " %s\n"
-
- :body-list-format "* %s\n"
- :body-number-list-format "# %s\n"
-
- :body-bullet-list-prefix ("* " "** " "*** " "**** " "***** ")
- )
-
- ;;
- ;; minimal html exporter
- ;;
- ("html"
- ;; simple html output
- :file-suffix ".html"
- :key-binding ?h
-
- :header-prefix "<body>"
-
- :title-format "<h1>%s</h1>\n\n"
-
- :date-export t
- :date-format "<br /><b>Date:</b> <i>%s</i><br />\n\n"
-
- :toc-export nil
-
- :body-header-section-numbers 3
-
- :body-section-header-prefix ("<h1>" "<h2>" "<h3>"
- "<h4>" "<h5>" "<h6>")
- :body-section-header-format "%s"
- :body-section-header-suffix ("</h1>\n" "</h2>\n" "</h3>\n"
- "</h4>\n" "</h5>\n" "</h6>\n")
-
- :body-section-prefix "<secprefix>\n"
- :body-section-suffix "</secsuffix>\n"
-; :body-section-prefix ("<sec1>\n" "<sec2>\n" "<sec3>\n")
-; :body-section-suffix ("</sec1>\n" "</sec2>\n" "</sec3>\n")
-
- :body-line-export-preformated t
- :body-line-format "%s\n"
-
- :body-text-prefix "<p>\n"
- :body-text-suffix "</p>\n"
-
- :body-bullet-list-prefix (?* ?+ ?-)
-; :body-bullet-list-suffix (?* ?+ ?-)
- )
-
- ;;
- ;; internet-draft .xml for xml2rfc exporter
- ;;
- ("ietfid"
- ;; this tries to use every specifier for demo purposes
- :file-suffix ".xml"
- :key-binding ?i
-
- :title-prefix "<?xml version=\"1.0\"\?>
-<!DOCTYPE rfc SYSTEM \"rfc2629.dtd\" [
-<!ENTITY rfcs PUBLIC '' 'blah'>
-<?rfc strict=\"yes\" ?>
-<?rfc toc=\"yes\" ?>
-<?rfc tocdepth=\"4\" ?>
-<?rfc symrefs=\"yes\" ?>
-<?rfc compact=\"yes\" ?>
-<?rfc subcompact=\"no\" ?>
-<rfc category=\"std\" ipr=\"pre5378Trust200902\" docName=\"FILLME.txt\">
- <front>
-"
- :title-format "<title abbrev=\"ABBREV HERE\">\n%s\n</title>\n"
- :title-suffix "<author initials=\"A.A\" surname=\"LASTNAME\" fullname=\"FULL NAME\">
- <organization>Comany, Inc..</organization>
- <address>
- <postal>
- <street></street>
- <city></city>
- <region></region>
- <code></code>
- <country></country>
- </postal>
- <phone></phone>
- <email></email>
- </address>
- </author>
- <date month=\"FILLMONTH\" year=\"FILLYEAR\"/>
- <area>Operations and Management</area>
- <workgroup>FIXME</workgroup>
-<abstract>\n"
- :date-export nil
-
- :toc-export nil
-
- :body-header-section-numbers nil
-
- :body-section-header-format "<section title=\"%s\">\n"
- :body-section-suffix "</section>\n"
-
- ; if preformated text should be included (eg, : prefixed)
- :body-line-export-preformated t
- :body-line-fixed-prefix "<figure>\n<artwork>\n"
- :body-line-fixed-suffix "\n</artwork>\n</figure>\n"
-
- ; other body lines
- :body-line-format "%s"
- :body-line-wrap 75
-
- ; print above and below all body parts
- :body-text-prefix "<t>\n"
- :body-text-suffix "</t>\n"
-
- :body-list-prefix "<list style=\"symbols\">\n"
- :body-list-suffix "</list>\n"
- :body-list-format "<t>%s</t>\n"
-
- )
- )
- "A assoc list of property lists to specify export definitions"
-)
-
-(setq org-generic-export-type "demo")
-
-(defvar org-export-generic-section-type "")
-(defvar org-export-generic-section-suffix "")
-
-;;;###autoload
-(defun org-set-generic-type (type definition)
- "Adds a TYPE and DEFINITION to the existing list of defined generic
-export definitions."
- (aput 'org-generic-alist type definition))
-
-;;; helper functions for org-set-generic-type
-(defvar org-export-generic-keywords nil)
-(defmacro* def-org-export-generic-keyword (keyword
- &key documentation
- type)
- "Define KEYWORD as a legitimate element for inclusion in
-the body of an org-set-generic-type definition."
- `(progn
- (pushnew ,keyword org-export-generic-keywords)
- ;; TODO: push the documentation and type information
- ;; somewhere where it will do us some good.
- ))
-
-(def-org-export-generic-keyword :body-newline-paragraph
- :documentation "Bound either to NIL or to a pattern to be
-inserted in the output for every blank line in the input.
- The intention is to handle formats where text is flowed, and
-newlines are interpreted as significant \(e.g., as indicating
-preformatted text\). A common non-nil value for this keyword
-is \"\\n\". Should typically be combined with a value for
-:body-line-format that does NOT end with a newline."
- :type string)
-
-;;; fontification keywords
-(def-org-export-generic-keyword :bold-format)
-(def-org-export-generic-keyword :italic-format)
-(def-org-export-generic-keyword :underline-format)
-(def-org-export-generic-keyword :strikethrough-format)
-(def-org-export-generic-keyword :code-format)
-(def-org-export-generic-keyword :verbatim-format)
-
-
-
-
-(defun org-export-generic-remember-section (type suffix &optional prefix)
- (setq org-export-generic-section-type type)
- (setq org-export-generic-section-suffix suffix)
- (if prefix
- (insert prefix))
-)
-
-(defun org-export-generic-check-section (type &optional prefix suffix)
- "checks to see if type is already in use, or we're switching parts
-If we're switching, then insert a potentially previously remembered
-suffix, and insert the current prefix immediately and then save the
-suffix a later change time."
-
- (when (not (equal type org-export-generic-section-type))
- (if org-export-generic-section-suffix
- (insert org-export-generic-section-suffix))
- (setq org-export-generic-section-type type)
- (setq org-export-generic-section-suffix suffix)
- (if prefix
- (insert prefix))))
-
-;;;###autoload
-(defun org-export-generic (arg)
- "Export the outline as generic output.
-If there is an active region, export only the region.
-The prefix ARG specifies how many levels of the outline should become
-underlined headlines. The default is 3."
- (interactive "P")
- (setq-default org-todo-line-regexp org-todo-line-regexp)
- (let* ((opt-plist (org-combine-plists (org-default-export-plist)
- (org-infile-export-plist)))
- (region-p (org-region-active-p))
- (rbeg (and region-p (region-beginning)))
- (rend (and region-p (region-end)))
- (subtree-p
- (when region-p
- (save-excursion
- (goto-char rbeg)
- (and (org-at-heading-p)
- (>= (org-end-of-subtree t t) rend)))))
- (level-offset (if subtree-p
- (save-excursion
- (goto-char rbeg)
- (+ (funcall outline-level)
- (if org-odd-levels-only 1 0)))
- 0))
- (opt-plist (setq org-export-opt-plist
- (if subtree-p
- (org-export-add-subtree-options opt-plist rbeg)
- opt-plist)))
-
- helpstart
- (bogus (mapc (lambda (x)
- (setq helpstart
- (concat helpstart "\["
- (char-to-string
- (plist-get (cdr x) :key-binding))
- "] " (car x) "\n")))
- org-generic-alist))
-
- (help (concat helpstart "
-
-\[ ] the current setting of the org-generic-export-type variable
-"))
-
- (cmds
-
- (append
- (mapcar (lambda (x)
- (list
- (plist-get (cdr x) :key-binding)
- (car x)))
- org-generic-alist)
- (list (list ? "default"))))
-
- r1 r2 ass
-
- ;; read in the type to use
- (export-plist
- (progn
- (save-excursion
- (save-window-excursion
- (delete-other-windows)
- (with-output-to-temp-buffer "*Org Export/Generic Styles Help*"
- (princ help))
- (org-fit-window-to-buffer (get-buffer-window
- "*Org Export/Generic Styles Help*"))
- (message "Select command: ")
- (setq r1 (read-char-exclusive))))
- (setq r2 (if (< r1 27) (+ r1 96) r1))
- (unless (setq ass (cadr (assq r2 cmds)))
- (error "No command associated with key %c" r1))
-
- (cdr (assoc
- (if (equal ass "default") org-generic-export-type ass)
- org-generic-alist))))
-
- (custom-times org-display-custom-times)
- (org-generic-current-indentation '(0 . 0))
- (level 0) (old-level 0) line txt lastwastext
- (umax nil)
- (umax-toc nil)
- (case-fold-search nil)
- (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer))))
- (filesuffix (or (plist-get export-plist :file-suffix) ".foo"))
- (filename (concat (file-name-as-directory
- (org-export-directory :ascii opt-plist))
- (file-name-sans-extension
- (or (and subtree-p
- (org-entry-get (region-beginning)
- "EXPORT_FILE_NAME" t))
- (file-name-nondirectory bfname)))
- filesuffix))
- (filename (if (equal (file-truename filename)
- (file-truename bfname))
- (concat filename filesuffix)
- filename))
- (buffer (find-file-noselect filename))
- (org-levels-open (make-vector org-level-max nil))
- (odd org-odd-levels-only)
- (date (plist-get opt-plist :date))
- (author (plist-get opt-plist :author))
- (title (or (and subtree-p (org-export-get-title-from-subtree))
- (plist-get opt-plist :title)
- (and (not
- (plist-get opt-plist :skip-before-1st-heading))
- (org-export-grab-title-from-buffer))
- (file-name-sans-extension
- (file-name-nondirectory bfname))))
- (email (plist-get opt-plist :email))
- (language (plist-get opt-plist :language))
- (quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
-; (quote-re (concat "^\\(\\*+\\)\\([ \t]*" org-quote-string "\\>\\)"))
- (todo nil)
- (lang-words nil)
- (region
- (buffer-substring
- (if (org-region-active-p) (region-beginning) (point-min))
- (if (org-region-active-p) (region-end) (point-max))))
- (lines (org-split-string
- (org-export-preprocess-string
- region
- :for-ascii t
- :skip-before-1st-heading
- (plist-get opt-plist :skip-before-1st-heading)
- :drawers (plist-get export-plist :drawers-export)
- :tags (plist-get export-plist :tags-export)
- :priority (plist-get export-plist :priority-export)
- :footnotes (plist-get export-plist :footnotes-export)
- :timestamps (plist-get export-plist :timestamps-export)
- :todo-keywords (plist-get export-plist :todo-keywords-export)
- :verbatim-multiline t
- :select-tags (plist-get export-plist :select-tags-export)
- :exclude-tags (plist-get export-plist :exclude-tags-export)
- :emph-multiline t
- :archived-trees
- (plist-get export-plist :archived-trees-export)
- :add-text (plist-get opt-plist :text))
- "\n"))
- ;; export-generic plist variables
- (withtags (plist-get export-plist :tags-export))
- (tagsintoc (plist-get export-plist :toc-tags-export))
- (tocnotagsstr (or (plist-get export-plist :toc-tags-none-string) ""))
- (tocdepth (plist-get export-plist :toc-indent-depth))
- (tocindentchar (plist-get export-plist :toc-indent-char))
- (tocsecnums (plist-get export-plist :toc-section-numbers))
- (tocsecnumform (plist-get export-plist :toc-section-number-format))
- (tocformat (plist-get export-plist :toc-format))
- (tocformtodo (plist-get export-plist :toc-format-with-todo))
- (tocprefix (plist-get export-plist :toc-prefix))
- (tocsuffix (plist-get export-plist :toc-suffix))
- (bodyfixedpre (plist-get export-plist :body-line-fixed-prefix))
- (bodyfixedsuf (plist-get export-plist :body-line-fixed-suffix))
- (bodyfixedform (or (plist-get export-plist :body-line-fixed-format)
- "%s"))
- (listprefix (plist-get export-plist :body-list-prefix))
- (listsuffix (plist-get export-plist :body-list-suffix))
- (listformat (or (plist-get export-plist :body-list-format) "%s\n"))
- (numlistleavenum
- (plist-get export-plist :body-number-list-leave-number))
- (numlistprefix (plist-get export-plist :body-number-list-prefix))
- (numlistsuffix (plist-get export-plist :body-number-list-suffix))
- (numlistformat
- (or (plist-get export-plist :body-number-list-format) "%s\n"))
- (listchecktodo
- (or (plist-get export-plist :body-list-checkbox-todo) "\\1"))
- (listcheckdone
- (or (plist-get export-plist :body-list-checkbox-done) "\\1"))
- (listcheckhalf
- (or (plist-get export-plist :body-list-checkbox-half) "\\1"))
- (listchecktodoend
- (or (plist-get export-plist :body-list-checkbox-todo-end) ""))
- (listcheckdoneend
- (or (plist-get export-plist :body-list-checkbox-done-end) ""))
- (listcheckhalfend
- (or (plist-get export-plist :body-list-checkbox-half-end) ""))
- (bodynewline-paragraph (plist-get export-plist :body-newline-paragraph))
- (bodytextpre (plist-get export-plist :body-text-prefix))
- (bodytextsuf (plist-get export-plist :body-text-suffix))
- (bodylinewrap (plist-get export-plist :body-line-wrap))
- (bodylineform (or (plist-get export-plist :body-line-format) "%s"))
- (blockquotestart (or (plist-get export-plist :blockquote-start) "\n\n\t"))
- (blockquoteend (or (plist-get export-plist :blockquote-end) "\n\n"))
-
- ;; dynamic variables used heinously in fontification
- ;; not referenced locally...
- (format-boldify (plist-get export-plist :bold-format))
- (format-italicize (plist-get export-plist :italic-format))
- (format-underline (plist-get export-plist :underline-format))
- (format-strikethrough (plist-get export-plist :strikethrough-format))
- (format-code (plist-get export-plist :code-format))
- (format-verbatim (plist-get export-plist :verbatim-format))
-
-
-
- thetoc toctags have-headings first-heading-pos
- table-open table-buffer link-buffer link desc desc0 rpl wrap)
-
- (let ((inhibit-read-only t))
- (org-unmodified
- (remove-text-properties (point-min) (point-max)
- '(:org-license-to-kill t))))
-
- (setq org-min-level (org-get-min-level lines level-offset))
- (setq org-last-level org-min-level)
- (org-init-section-numbers)
-
- (find-file-noselect filename)
-
- (setq lang-words (or (assoc language org-export-language-setup)
- (assoc "en" org-export-language-setup)))
- (switch-to-buffer-other-window buffer)
- (erase-buffer)
- (fundamental-mode)
- ;; create local variables for all options, to make sure all called
- ;; functions get the correct information
- (mapc (lambda (x)
- (set (make-local-variable (nth 2 x))
- (plist-get opt-plist (car x))))
- org-export-plist-vars)
- (org-set-local 'org-odd-levels-only odd)
- (setq umax (if arg (prefix-numeric-value arg)
- org-export-headline-levels))
- (setq umax-toc umax)
-
- ;; File header
- (if title
- (insert
- (org-export-generic-header title export-plist
- :title-prefix
- :title-format
- :title-suffix)))
-
- (if (and (or author email)
- (plist-get export-plist :author-export))
- (insert (concat (nth 1 lang-words) ": " (or author "")
- (if email (concat " <" email ">") "")
- "\n")))
-
- (cond
- ((and date (string-match "%" date))
- (setq date (format-time-string date)))
- (date)
- (t (setq date (format-time-string "%Y-%m-%d %T %Z"))))
-
- (if (and date (plist-get export-plist :date-export))
- (insert
- (org-export-generic-header date export-plist
- :date-prefix
- :date-format
- :date-suffix)))
-
- ;; export the table of contents first
- (if (plist-get export-plist :toc-export)
- (progn
- (push
- (org-export-generic-header (nth 3 lang-words) export-plist
- :toc-header-prefix
- :toc-header-format
- :toc-header-suffix)
- thetoc)
-
- (if tocprefix
- (push tocprefix thetoc))
-
- (mapc '(lambda (line)
- (if (string-match org-todo-line-regexp line)
- ;; This is a headline
- (progn
- (setq have-headings t)
- (setq level (- (match-end 1) (match-beginning 1)
- level-offset)
- level (org-tr-level level)
- txt (match-string 3 line)
- todo
- (or (and org-export-mark-todo-in-toc
- (match-beginning 2)
- (not (member (match-string 2 line)
- org-done-keywords)))
- ; TODO, not DONE
- (and org-export-mark-todo-in-toc
- (= level umax-toc)
- (org-search-todo-below
- line lines level))))
- (setq txt (org-html-expand-for-generic txt))
-
- (while (string-match org-bracket-link-regexp txt)
- (setq txt
- (replace-match
- (match-string (if (match-end 2) 3 1) txt)
- t t txt)))
-
- (if (and (not tagsintoc)
- (string-match
- (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$")
- txt))
- (setq txt (replace-match "" t t txt))
- ; include tags but formated
- (if (string-match
- (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$")
- txt)
- (progn
- (setq
- toctags
- (org-export-generic-header
- (match-string 1 txt)
- export-plist :toc-tags-prefix
- :toc-tags-format :toc-tags-suffix))
- (string-match
- (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$")
- txt)
- (setq txt (replace-match "" t t txt)))
- (setq toctags tocnotagsstr)))
-
- (if (string-match quote-re0 txt)
- (setq txt (replace-match "" t t txt)))
-
- (if (<= level umax-toc)
- (progn
- (push
- (concat
-
- (make-string
- (* (max 0 (- level org-min-level)) tocdepth)
- tocindentchar)
-
- (if tocsecnums
- (format tocsecnumform
- (org-section-number level))
- "")
-
- (format
- (if todo tocformtodo tocformat)
- txt)
-
- toctags)
-
- thetoc)
- (setq org-last-level level))
- ))))
- lines)
- (if tocsuffix
- (push tocsuffix thetoc))
- (setq thetoc (if have-headings (nreverse thetoc) nil))))
-
- (org-init-section-numbers)
- (org-export-generic-check-section "top")
- (while (setq line (pop lines))
- (when (and link-buffer (string-match "^\\*+ " line))
- (org-export-generic-push-links (nreverse link-buffer))
- (setq link-buffer nil))
- (setq wrap nil)
- ;; Remove the quoted HTML tags.
- ;; XXX
- (setq line (org-html-expand-for-generic line))
- ;; Replace links with the description when possible
- ;; XXX
- (while (string-match org-bracket-link-regexp line)
- (setq link (match-string 1 line)
- desc0 (match-string 3 line)
- desc (or desc0 (match-string 1 line)))
- (if (and (> (length link) 8)
- (equal (substring link 0 8) "coderef:"))
- (setq line (replace-match
- (format (org-export-get-coderef-format (substring link 8) desc)
- (cdr (assoc
- (substring link 8)
- org-export-code-refs)))
- t t line))
- (setq rpl (concat "["
- (or (match-string 3 line) (match-string 1 line))
- "]"))
- (when (and desc0 (not (equal desc0 link)))
- (if org-export-generic-links-to-notes
- (push (cons desc0 link) link-buffer)
- (setq rpl (concat rpl " (" link ")")
- wrap (+ (length line) (- (length (match-string 0 line)))
- (length desc)))))
- (setq line (replace-match rpl t t line))))
- (when custom-times
- (setq line (org-translate-time line)))
- (cond
- ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
- ;;
- ;; a Headline
- ;;
- (org-export-generic-check-section "headline")
-
- (setq first-heading-pos (or first-heading-pos (point)))
- (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
- level-offset))
- txt (match-string 2 line))
- (org-generic-level-start level old-level txt umax export-plist lines)
- (setq old-level level))
-
- ((and org-export-with-tables
- (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
- ;;
- ;; a Table
- ;;
- (org-export-generic-check-section "table")
-
- (if (not table-open)
- ;; New table starts
- (setq table-open t table-buffer nil))
- ;; Accumulate table lines
- (setq table-buffer (cons line table-buffer))
- (when (or (not lines)
- (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
- (car lines))))
- (setq table-open nil
- table-buffer (nreverse table-buffer))
- (insert (mapconcat
- (lambda (x)
- (org-fix-indentation x org-generic-current-indentation))
- (org-format-table-generic table-buffer)
- "\n") "\n")))
-
- ((string-match "^\\([ \t]*\\)\\(:\\( \\|$\\)\\)" line)
- ;;
- ;; pre-formatted text
- ;;
- (setq line (replace-match "\\1" nil nil line))
-
- (org-export-generic-check-section "preformat" bodyfixedpre bodyfixedsuf)
-
- (insert (format bodyfixedform line)))
-
- ((or (string-match "^\\([ \t]*\\)\\([\-\+][ \t]*\\)" line)
- ;; if the bullet list item is an asterisk, the leading space is /mandatory/
- ;; [2010/02/02:rpg]
- (string-match "^\\([ \t]+\\)\\(\\*[ \t]*\\)" line))
- ;;
- ;; plain list item
- ;; TODO: nested lists
- ;;
- ;; first add a line break between any previous paragraph or line item and this
- ;; one
- (when bodynewline-paragraph
- (insert bodynewline-paragraph))
-
- ;; I believe this gets rid of leading whitespace.
- (setq line (replace-match "" nil nil line))
-
- ;; won't this insert the suffix /before/ the last line of the list?
- ;; also isn't it spoofed by bulleted lists that have a line skip between the list items
- ;; unless 'org-empty-line-terminates-plain-lists' is true?
- (org-export-generic-check-section "liststart" listprefix listsuffix)
-
- ;; deal with checkboxes
- (cond
- ((string-match "^\\(\\[ \\]\\)[ \t]*" line)
- (setq line (concat (replace-match listchecktodo nil nil line)
- listchecktodoend)))
- ((string-match "^\\(\\[X\\]\\)[ \t]*" line)
- (setq line (concat (replace-match listcheckdone nil nil line)
- listcheckdoneend)))
- ((string-match "^\\(\\[/\\]\\)[ \t]*" line)
- (setq line (concat (replace-match listcheckhalf nil nil line)
- listcheckhalfend)))
- )
-
- (insert (format listformat (org-export-generic-fontify line))))
- ((string-match "^\\([ \t]+\\)\\([0-9]+\\.[ \t]*\\)" line)
- ;;
- ;; numbered list item
- ;;
- ;; TODO: nested lists
- ;;
- (setq line (replace-match (if numlistleavenum "\\2" "") nil nil line))
-
- (org-export-generic-check-section "numliststart"
- numlistprefix numlistsuffix)
-
- ;; deal with checkboxes
- ;; TODO: whoops; leaving the numbers is a problem for ^ matching
- (cond
- ((string-match "\\(\\[ \\]\\)[ \t]*" line)
- (setq line (concat (replace-match listchecktodo nil nil line)
- listchecktodoend)))
- ((string-match "\\(\\[X\\]\\)[ \t]*" line)
- (setq line (concat (replace-match listcheckdone nil nil line)
- listcheckdoneend)))
- ((string-match "\\(\\[/\\]\\)[ \t]*" line)
- (setq line (concat (replace-match listcheckhalf nil nil line)
- listcheckhalfend)))
- )
-
- (insert (format numlistformat (org-export-generic-fontify line))))
-
- ((equal line "ORG-BLOCKQUOTE-START")
- (setq line blockquotestart))
- ((equal line "ORG-BLOCKQUOTE-END")
- (setq line blockquoteend))
- ((string-match "^\\s-*$" line)
- ;; blank line
- (if bodynewline-paragraph
- (insert bodynewline-paragraph)))
- (t
- ;;
- ;; body
- ;;
- (org-export-generic-check-section "body" bodytextpre bodytextsuf)
-
- (setq line
- (org-export-generic-fontify line))
-
- ;; XXX: properties? list?
- (if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)" line)
- (setq line (replace-match "\\1\\3:" t nil line)))
-
- (setq line (org-fix-indentation line org-generic-current-indentation))
-
- ;; Remove forced line breaks
- (if (string-match "\\\\\\\\[ \t]*$" line)
- (setq line (replace-match "" t t line)))
-
- (if bodylinewrap
- ;; XXX: was dependent on wrap var which was calculated by???
- (if (> (length line) bodylinewrap)
- (setq line
- (org-export-generic-wrap line bodylinewrap))
- (setq line line)))
- (insert (format bodylineform line)))))
-
- ;; if we're at a level > 0; insert the closing body level stuff
- (let ((counter 0))
- (while (> (- level counter) 0)
- (insert
- (org-export-generic-format export-plist :body-section-suffix 0
- (- level counter)))
- (setq counter (1+ counter))))
-
- (org-export-generic-check-section "bottom")
-
- (org-export-generic-push-links (nreverse link-buffer))
-
- (normal-mode)
-
- ;; insert the table of contents
- (when thetoc
- (goto-char (point-min))
- (if (re-search-forward "^[ \t]*\\[TABLE-OF-CONTENTS\\][ \t]*$" nil t)
- (progn
- (goto-char (match-beginning 0))
- (replace-match ""))
- (goto-char first-heading-pos))
- (mapc 'insert thetoc)
- (or (looking-at "[ \t]*\n[ \t]*\n")
- (insert "\n\n")))
-
- ;; Convert whitespace place holders
- (goto-char (point-min))
- (let (beg end)
- (while (setq beg (next-single-property-change (point) 'org-whitespace))
- (setq end (next-single-property-change beg 'org-whitespace))
- (goto-char beg)
- (delete-region beg end)
- (insert (make-string (- end beg) ?\ ))))
-
- (save-buffer)
-
- ;; remove display and invisible chars
- (let (beg end)
- (goto-char (point-min))
- (while (setq beg (next-single-property-change (point) 'display))
- (setq end (next-single-property-change beg 'display))
- (delete-region beg end)
- (goto-char beg)
- (insert "=>"))
- (goto-char (point-min))
- (while (setq beg (next-single-property-change (point) 'org-cwidth))
- (setq end (next-single-property-change beg 'org-cwidth))
- (delete-region beg end)
- (goto-char beg)))
- (goto-char (point-min))))
-
-
-(defun org-export-generic-format (export-plist prop &optional len n reverse)
- "converts a property specification to a string given types of properties
-
-The EXPORT-PLIST should be defined as the lookup plist.
-The PROP should be the property name to search for in it.
-LEN is set to the length of multi-characters strings to generate (or 0)
-N is the tree depth
-REVERSE means to reverse the list if the plist match is a list
- "
- (let* ((prefixtype (plist-get export-plist prop))
- subtype)
- (cond
- ((null prefixtype) "")
- ((and len (char-or-string-p prefixtype) (not (stringp prefixtype)))
- ;; sequence of chars
- (concat (make-string len prefixtype) "\n"))
- ((stringp prefixtype)
- prefixtype)
- ((and n (listp prefixtype))
- (if reverse
- (setq prefixtype (reverse prefixtype)))
- (setq subtype (if (> n (length prefixtype))
- (car (last prefixtype))
- (nth (1- n) prefixtype)))
- (if (stringp subtype)
- subtype
- (concat (make-string len subtype) "\n")))
- (t ""))
- ))
-
-(defun org-export-generic-header (header export-plist
- prefixprop formatprop postfixprop
- &optional n reverse)
- "convert a header to an output string given formatting property names"
- (let* ((formatspec (plist-get export-plist formatprop))
- (len (length header)))
- (concat
- (org-export-generic-format export-plist prefixprop len n reverse)
- (format (or formatspec "%s") header)
- (org-export-generic-format export-plist postfixprop len n reverse))
- ))
-
-(defun org-export-generic-preprocess (parameters)
- "Do extra work for ASCII export"
- ;; Put quotes around verbatim text
- (goto-char (point-min))
- (while (re-search-forward org-verbatim-re nil t)
- (goto-char (match-end 2))
- (backward-delete-char 1) (insert "'")
- (goto-char (match-beginning 2))
- (delete-char 1) (insert "`")
- (goto-char (match-end 2)))
- ;; Remove target markers
- (goto-char (point-min))
- (while (re-search-forward "<<<?\\([^<>]*\\)>>>?\\([ \t]*\\)" nil t)
- (replace-match "\\1\\2")))
-
-(defun org-html-expand-for-generic (line)
- "Handle quoted HTML for ASCII export."
- (if org-export-html-expand
- (while (string-match "@<[^<>\n]*>" line)
- ;; We just remove the tags for now.
- (setq line (replace-match "" nil nil line))))
- line)
-
-(defun org-export-generic-wrap (line where)
- "Wrap LINE at or before WHERE."
- (let* ((ind (org-get-indentation line))
- (indstr (make-string ind ?\ ))
- (len (length line))
- (result "")
- pos didfirst)
- (while (> len where)
- (catch 'found
- (loop for i from where downto (/ where 2) do
- (and (equal (aref line i) ?\ )
- (setq pos i)
- (throw 'found t))))
- (if pos
- (progn
- (setq result
- (concat result
- (if didfirst indstr "")
- (substring line 0 pos)
- "\n"))
- (setq didfirst t)
- (setq line (substring line (1+ pos)))
- (setq len (length line)))
- (setq result (concat result line))
- (setq len 0)))
- (concat result indstr line)))
-
-(defun org-export-generic-push-links (link-buffer)
- "Push out links in the buffer."
- (when link-buffer
- ;; We still have links to push out.
- (insert "\n")
- (let ((ind ""))
- (save-match-data
- (if (save-excursion
- (re-search-backward
- "^\\(\\([ \t]*\\)\\|\\(\\*+ \\)\\)[^ \t\n]" nil t))
- (setq ind (or (match-string 2)
- (make-string (length (match-string 3)) ?\ )))))
- (mapc (lambda (x) (insert ind "[" (car x) "]: " (cdr x) "\n"))
- link-buffer))
- (insert "\n")))
-
-(defun org-generic-level-start (level old-level title umax export-plist
- &optional lines)
- "Insert a new level in a generic export."
- (let ((n (- level umax 1))
- (ind 0)
- (diff (- level old-level)) (counter 0)
- (secnums (plist-get export-plist :body-header-section-numbers))
- (secnumformat
- (plist-get export-plist :body-header-section-number-format))
- char tagstring)
- (unless org-export-with-tags
- (if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title)
- (setq title (replace-match "" t t title))))
-
- (cond
- ;; going deeper
- ((> level old-level)
- (while (< (+ old-level counter) (1- level))
- (insert
- (org-export-generic-format export-plist :body-section-prefix 0
- (+ old-level counter)))
- (setq counter (1+ counter))
- ))
- ;; going up
- ((< level old-level)
- (while (> (- old-level counter) (1- level))
- (insert
- (org-export-generic-format export-plist :body-section-suffix 0
- (- old-level counter)))
- (setq counter (1+ counter))
- ))
- ;; same level
- ((= level old-level)
- (insert
- (org-export-generic-format export-plist :body-section-suffix 0 level))
- )
- )
- (insert
- (org-export-generic-format export-plist :body-section-prefix 0 level))
-
- (if (and org-export-with-section-numbers
- secnums
- (or (not (numberp secnums))
- (< level secnums)))
- (setq title
- (concat (format (or secnumformat "%s ")
- (org-section-number level)) title)))
-
- ;; handle tags and formatting
- (if (string-match
- (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") title)
- (progn
- (if (plist-get export-plist :body-tags-export)
- (setq tagstring (org-export-generic-header (match-string 1 title)
- export-plist
- :body-tags-prefix
- :body-tags-format
- :body-tags-suffix)))
- (string-match (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$") title)
- (setq title (replace-match "" t t title)))
- (setq tagstring (plist-get export-plist :body-tags-none-string)))
-
- (insert
- (org-export-generic-header title export-plist
- :body-section-header-prefix
- :body-section-header-format
- :body-section-header-suffix
- level))
- (if tagstring
- (insert tagstring))
-
- (setq org-generic-current-indentation '(0 . 0))))
-
-(defun org-insert-centered (s &optional underline)
- "Insert the string S centered and underline it with character UNDERLINE."
- (let ((ind (max (/ (- fill-column (string-width s)) 2) 0)))
- (insert (make-string ind ?\ ) s "\n")
- (if underline
- (insert (make-string ind ?\ )
- (make-string (string-width s) underline)
- "\n"))))
-
-(defvar org-table-colgroup-info nil)
-(defun org-format-table-generic (lines)
- "Format a table for ascii export."
- (if (stringp lines)
- (setq lines (org-split-string lines "\n")))
- (if (not (string-match "^[ \t]*|" (car lines)))
- ;; Table made by table.el - test for spanning
- lines
-
- ;; A normal org table
- ;; Get rid of hlines at beginning and end
- (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
- (setq lines (nreverse lines))
- (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
- (setq lines (nreverse lines))
- (when org-export-table-remove-special-lines
- ;; Check if the table has a marking column. If yes remove the
- ;; column and the special lines
- (setq lines (org-table-clean-before-export lines)))
- ;; Get rid of the vertical lines except for grouping
- (let ((vl (org-colgroup-info-to-vline-list org-table-colgroup-info))
- rtn line vl1 start)
- (while (setq line (pop lines))
- (if (string-match org-table-hline-regexp line)
- (and (string-match "|\\(.*\\)|" line)
- (setq line (replace-match " \\1" t nil line)))
- (setq start 0 vl1 vl)
- (while (string-match "|" line start)
- (setq start (match-end 0))
- (or (pop vl1) (setq line (replace-match " " t t line)))))
- (push line rtn))
- (nreverse rtn))))
-
-(defun org-colgroup-info-to-vline-list (info)
- (let (vl new last)
- (while info
- (setq last new new (pop info))
- (if (or (memq last '(:end :startend))
- (memq new '(:start :startend)))
- (push t vl)
- (push nil vl)))
- (setq vl (nreverse vl))
- (and vl (setcar vl nil))
- vl))
-
-
-;;; FIXME: this should probably turn into a defconstant later [2010/05/20:rpg]
-(defvar org-export-generic-emphasis-alist
- '(("*" format-boldify nil)
- ("/" format-italicize nil)
- ("_" format-underline nil)
- ("+" format-strikethrough nil)
- ("=" format-code t)
- ("~" format-verbatim t))
- "Alist of org format -> formatting variables for fontification.
-Each element of the list is a list of three elements.
-The first element is the character used as a marker for fontification.
-The second element is a variable name, set in org-export-generic. That
-variable will be dereferenced to obtain a formatting string to wrap
-fontified text with.
-The third element decides whether to protect converted text from other
-conversions.")
-
-;;; Cargo-culted from the latex translation. I couldn't figure out how
-;;; to keep the structure since the generic export operates on lines, rather
-;;; than on a buffer as in the latex export, meaning that none of the
-;;; search forward code could be kept. This led me to rewrite the
-;;; whole thing recursively. A huge lose for efficiency (potentially),
-;;; but I couldn't figure out how to make the looping work.
-;;; Worse, it's /doubly/ recursive, because this function calls
-;;; org-export-generic-emph-format, which can call it recursively...
-;;; [2010/05/20:rpg]
-(defun org-export-generic-fontify (string)
- "Convert fontification according to generic rules."
- (if (string-match org-emph-re string)
- ;; The match goes one char after the *string*, except at the end of a line
- (let ((emph (assoc (match-string 3 string)
- org-export-generic-emphasis-alist))
- (beg (match-beginning 0))
- (end (match-end 0)))
- (unless emph
- (message "`org-export-generic-emphasis-alist' has no entry for formatting triggered by \"%s\""
- (match-string 3 string)))
- ;; now we need to determine whether we have strikethrough or
- ;; a list, which is a bit nasty
- (if (and (equal (match-string 3 string) "+")
- (save-match-data
- (string-match "\\`-+\\'" (match-string 4 string))))
- ;; a list --- skip this match and recurse on the point after the
- ;; first emph char...
- (concat (substring string 0 (1+ (match-beginning 3)))
- (org-export-generic-fontify (substring string (match-beginning 3))))
- (concat (substring string 0 beg) ;; part before the match
- (match-string 1 string)
- (org-export-generic-emph-format (second emph)
- (match-string 4 string)
- (third emph))
- (or (match-string 5 string) "")
- (org-export-generic-fontify (substring string end)))))
- string))
-
-(defun org-export-generic-emph-format (format-varname string protect)
- "Return a string that results from applying the markup indicated by
-FORMAT-VARNAME to STRING."
- (let ((format (symbol-value format-varname)))
- (let ((string-to-emphasize
- (if protect
- string
- (org-export-generic-fontify string))))
- (if format
- (format format string-to-emphasize)
- string-to-emphasize))))
-
-(provide 'org-generic)
-(provide 'org-export-generic)
-
-;;; org-export-generic.el ends here
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-git-link.el b/.emacs.d/org-7.4/contrib/lisp/org-git-link.el
deleted file mode 100644
index 195bf9b..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-git-link.el
+++ /dev/null
@@ -1,219 +0,0 @@
-;;; org-git-link.el --- Provide org links to specific file version
-
-;; Copyright (C) 2009 Reimar Finken
-
-;; Author: Reimar Finken <reimar.finken@gmx.de>
-;; Keywords: files, calendar, hypermedia
-
-;; 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 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distaributed 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, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; `org-git-link.el' defines two new link types. The `git' link
-;; type is meant to be used in the typical scenario and mimics the
-;; `file' link syntax as closely as possible. The `gitbare' link
-;; type exists mostly for debugging reasons, but also allows e.g.
-;; linking to files in a bare git repository for the experts.
-
-;; * User friendy form
-;; [[git:/path/to/file::searchstring]]
-
-;; This form is the familiar from normal org file links
-;; including search options. However, its use is
-;; restricted to files in a working directory and does not
-;; handle bare repositories on purpose (see the bare form for
-;; that).
-
-;; The search string references a commit (a tree-ish in Git
-;; terminology). The two most useful types of search strings are
-
-;; - A symbolic ref name, usually a branch or tag name (e.g.
-;; master or nobelprize).
-;; - A ref followed by the suffix @ with a date specification
-;; enclosed in a brace pair (e.g. {yesterday}, {1 month 2
-;; weeks 3 days 1 hour 1 second ago} or {1979-02-26 18:30:00})
-;; to specify the value of the ref at a prior point in time
-;;
-;; * Bare git form
-;; [[gitbare:$GIT_DIR::$OBJECT]]
-;;
-;; This is the more bare metal version, which gives the user most
-;; control. It directly translates to the git command
-;; git --no-pager --git-dir=$GIT_DIR show $OBJECT
-;; Using this version one can also view files from a bare git
-;; repository. For detailed information on how to specify an
-;; object, see the man page of `git-rev-parse' (section
-;; SPECIFYING REVISIONS). A specific blob (file) can be
-;; specified by a suffix clolon (:) followed by a path.
-
-;;; Code:
-
-(require 'org)
-(defcustom org-git-program "git"
- "Name of the git executable used to follow git links."
- :type '(string)
- :group 'org)
-
-;; org link functions
-;; bare git link
-(org-add-link-type "gitbare" 'org-gitbare-open)
-
-(defun org-gitbare-open (str)
- (let* ((strlist (org-git-split-string str))
- (gitdir (first strlist))
- (object (second strlist)))
- (org-git-open-file-internal gitdir object)))
-
-
-(defun org-git-open-file-internal (gitdir object)
- (let* ((sha (org-git-blob-sha gitdir object))
- (tmpdir (concat temporary-file-directory "org-git-" sha))
- (filename (org-git-link-filename object))
- (tmpfile (expand-file-name filename tmpdir)))
- (unless (file-readable-p tmpfile)
- (make-directory tmpdir)
- (with-temp-file tmpfile
- (org-git-show gitdir object (current-buffer))))
- (org-open-file tmpfile)
- (set-buffer (get-file-buffer tmpfile))
- (setq buffer-read-only t)))
-
-;; user friendly link
-(org-add-link-type "git" 'org-git-open)
-
-(defun org-git-open (str)
- (let* ((strlist (org-git-split-string str))
- (filepath (first strlist))
- (commit (second strlist))
- (dirlist (org-git-find-gitdir (file-truename filepath)))
- (gitdir (first dirlist))
- (relpath (second dirlist)))
- (org-git-open-file-internal gitdir (concat commit ":" relpath))))
-
-
-;; Utility functions (file names etc)
-
-(defun org-git-split-dirpath (dirpath)
- "Given a directory name, return '(dirname basname)"
- (let ((dirname (file-name-directory (directory-file-name dirpath)))
- (basename (file-name-nondirectory (directory-file-name dirpath))))
- (list dirname basename)))
-
-;; finding the git directory
-(defun org-git-find-gitdir (path)
- "Given a file (not necessarily existing) file path, return the
- a pair (gitdir relpath), where gitdir is the path to the first
- .git subdirectory found updstream and relpath is the rest of
- the path. Example: (org-git-find-gitdir
- \"~/gitrepos/foo/bar.txt\") returns
- '(\"/home/user/gitrepos/.git\" \"foo/bar.txt\"). When not in a git repository, return nil."
- (let ((dir (file-name-directory path))
- (relpath (file-name-nondirectory path)))
- (catch 'toplevel
- (while (not (file-exists-p (expand-file-name ".git" dir)))
- (let ((dirlist (org-git-split-dirpath dir)))
- (when (string= (second dirlist) "") ; at top level
- (throw 'toplevel nil))
- (setq dir (first dirlist)
- relpath (concat (file-name-as-directory (second dirlist)) relpath))))
- (list (expand-file-name ".git" dir) relpath))))
-
-
-(if (featurep 'xemacs)
- (defalias 'org-git-gitrepos-p 'org-git-find-gitdir)
- (defalias 'org-git-gitrepos-p 'org-git-find-gitdir
- "Return non-nil if path is in git repository"))
-
-;; splitting the link string
-
-;; Both link open functions are called with a string of
-;; consisting of two parts separated by a double colon (::).
-(defun org-git-split-string (str)
- "Given a string of the form \"str1::str2\", return a list of
- two substrings \'(\"str1\" \"str2\"). If the double colon is mising, take str2 to be the empty string."
- (let ((strlist (split-string str "::")))
- (cond ((= 1 (length strlist))
- (list (car strlist) ""))
- ((= 2 (length strlist))
- strlist)
- (t (error "org-git-split-string: only one :: allowed: %s" str)))))
-
-;; finding the file name part of a commit
-(defun org-git-link-filename (str)
- "Given an object description (see the man page of
- git-rev-parse), return the nondirectory part of the referenced
- filename, if it can be extracted. Otherwise, return a valid
- filename."
- (let* ((match (and (string-match "[^:]+$" str)
- (match-string 0 str)))
- (filename (and match (file-name-nondirectory match)))) ;extract the final part without slash
- filename))
-
-;; creating a link
-(defun org-git-create-searchstring (branch timestring)
- (concat branch "@{" timestring "}"))
-
-
-(defun org-git-create-git-link (file)
- "Create git link part to file at specific time"
- (interactive "FFile: ")
- (let* ((gitdir (first (org-git-find-gitdir (file-truename file))))
- (branchname (org-git-get-current-branch gitdir))
- (timestring (format-time-string "%Y-%m-%d" (current-time))))
- (org-make-link "git:" file "::" (org-git-create-searchstring branchname timestring))))
-
-(defun org-git-store-link ()
- "Store git link to current file."
- (when (buffer-file-name)
- (let ((file (abbreviate-file-name (buffer-file-name))))
- (when (org-git-gitrepos-p file)
- (org-store-link-props
- :type "git"
- :link (org-git-create-git-link file))))))
-
-(add-hook 'org-store-link-functions 'org-git-store-link)
-
-(defun org-git-insert-link-interactively (file searchstring &optional description)
- (interactive "FFile: \nsSearch string: \nsDescription: ")
- (insert (org-make-link-string (org-make-link "git:" file "::" searchstring) description)))
-
-;; Calling git
-(defun org-git-show (gitdir object buffer)
- "Show the output of git --git-dir=gitdir show object in buffer."
- (unless
- (zerop (call-process org-git-program nil buffer nil
- "--no-pager" (concat "--git-dir=" gitdir) "show" object))
- (error "git error: %s " (save-excursion (set-buffer buffer)
- (buffer-string)))))
-
-(defun org-git-blob-sha (gitdir object)
- "Return sha of the referenced object"
- (with-temp-buffer
- (if (zerop (call-process org-git-program nil t nil
- "--no-pager" (concat "--git-dir=" gitdir) "rev-parse" object))
- (buffer-substring (point-min) (1- (point-max))) ; to strip off final newline
- (error "git error: %s " (buffer-string)))))
-
-(defun org-git-get-current-branch (gitdir)
- "Return the name of the current branch."
- (with-temp-buffer
- (if (not (zerop (call-process org-git-program nil t nil
- "--no-pager" (concat "--git-dir=" gitdir) "symbolic-ref" "-q" "HEAD")))
- (error "git error: %s " (buffer-string))
- (goto-char (point-min))
- (if (looking-at "^refs/heads/") ; 11 characters
- (buffer-substring 12 (1- (point-max))))))) ; to strip off final newline
-
-(provide 'org-git-link)
-;;; org-git-link.el ends here
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-interactive-query.el b/.emacs.d/org-7.4/contrib/lisp/org-interactive-query.el
deleted file mode 100644
index 1051e7c..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-interactive-query.el
+++ /dev/null
@@ -1,310 +0,0 @@
-;;; org-interactive-query.el --- Interactive modification of agenda query
-;;
-;; Copyright 2007 Free Software Foundation, Inc.
-;;
-;; Author: Christopher League <league at contrapunctus dot net>
-;; Version: 1.0
-;; Keywords: org, wp
-;;
-;; 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 3, 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, write to the Free Software
-;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-;;
-;;; Commentary:
-;;
-
-;; This library implements interactive modification of a tags/todo query
-;; in the org-agenda. It adds 4 keys to the agenda
-;;
-;; / add a keyword as a positive selection criterion
-;; \ add a keyword as a newgative selection criterion
-;; = clear a keyword from the selection string
-;; ;
-
-(require 'org)
-
-(org-defkey org-agenda-mode-map "=" 'org-agenda-query-clear-cmd)
-(org-defkey org-agenda-mode-map "/" 'org-agenda-query-and-cmd)
-(org-defkey org-agenda-mode-map ";" 'org-agenda-query-or-cmd)
-(org-defkey org-agenda-mode-map "\\" 'org-agenda-query-not-cmd)
-
-;;; Agenda interactive query manipulation
-
-(defcustom org-agenda-query-selection-single-key t
- "Non-nil means query manipulation exits after first change.
-When nil, you have to press RET to exit it.
-During query selection, you can toggle this flag with `C-c'.
-This variable can also have the value `expert'. In this case, the window
-displaying the tags menu is not even shown, until you press C-c again."
- :group 'org-agenda
- :type '(choice
- (const :tag "No" nil)
- (const :tag "Yes" t)
- (const :tag "Expert" expert)))
-
-(defun org-agenda-query-selection (current op table &optional todo-table)
- "Fast query manipulation with single keys.
-CURRENT is the current query string, OP is the initial
-operator (one of \"+|-=\"), TABLE is an alist of tags and
-corresponding keys, possibly with grouping information.
-TODO-TABLE is a similar table with TODO keywords, should these
-have keys assigned to them. If the keys are nil, a-z are
-automatically assigned. Returns the new query string, or nil to
-not change the current one."
- (let* ((fulltable (append table todo-table))
- (maxlen (apply 'max (mapcar
- (lambda (x)
- (if (stringp (car x)) (string-width (car x)) 0))
- fulltable)))
- (fwidth (+ maxlen 3 1 3))
- (ncol (/ (- (window-width) 4) fwidth))
- (expert (eq org-agenda-query-selection-single-key 'expert))
- (exit-after-next org-agenda-query-selection-single-key)
- (done-keywords org-done-keywords)
- tbl char cnt e groups ingroup
- tg c2 c c1 ntable rtn)
- (save-window-excursion
- (if expert
- (set-buffer (get-buffer-create " *Org tags*"))
- (delete-other-windows)
- (split-window-vertically)
- (org-switch-to-buffer-other-window (get-buffer-create " *Org tags*")))
- (erase-buffer)
- (org-set-local 'org-done-keywords done-keywords)
- (insert "Query: " current "\n")
- (org-agenda-query-op-line op)
- (insert "\n\n")
- (org-fast-tag-show-exit exit-after-next)
- (setq tbl fulltable char ?a cnt 0)
- (while (setq e (pop tbl))
- (cond
- ((equal e '(:startgroup))
- (push '() groups) (setq ingroup t)
- (when (not (= cnt 0))
- (setq cnt 0)
- (insert "\n"))
- (insert "{ "))
- ((equal e '(:endgroup))
- (setq ingroup nil cnt 0)
- (insert "}\n"))
- (t
- (setq tg (car e) c2 nil)
- (if (cdr e)
- (setq c (cdr e))
- ;; automatically assign a character.
- (setq c1 (string-to-char
- (downcase (substring
- tg (if (= (string-to-char tg) ?@) 1 0)))))
- (if (or (rassoc c1 ntable) (rassoc c1 table))
- (while (or (rassoc char ntable) (rassoc char table))
- (setq char (1+ char)))
- (setq c2 c1))
- (setq c (or c2 char)))
- (if ingroup (push tg (car groups)))
- (setq tg (org-add-props tg nil 'face
- (cond
- ((not (assoc tg table))
- (org-get-todo-face tg))
- (t nil))))
- (if (and (= cnt 0) (not ingroup)) (insert " "))
- (insert "[" c "] " tg (make-string
- (- fwidth 4 (length tg)) ?\ ))
- (push (cons tg c) ntable)
- (when (= (setq cnt (1+ cnt)) ncol)
- (insert "\n")
- (if ingroup (insert " "))
- (setq cnt 0)))))
- (setq ntable (nreverse ntable))
- (insert "\n")
- (goto-char (point-min))
- (if (and (not expert) (fboundp 'fit-window-to-buffer))
- (fit-window-to-buffer))
- (setq rtn
- (catch 'exit
- (while t
- (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free%s%s"
- (if groups " [!] no groups" " [!]groups")
- (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi")))
- (setq c (let ((inhibit-quit t)) (read-char-exclusive)))
- (cond
- ((= c ?\r) (throw 'exit t))
- ((= c ?!)
- (setq groups (not groups))
- (goto-char (point-min))
- (while (re-search-forward "[{}]" nil t) (replace-match " ")))
- ((= c ?\C-c)
- (if (not expert)
- (org-fast-tag-show-exit
- (setq exit-after-next (not exit-after-next)))
- (setq expert nil)
- (delete-other-windows)
- (split-window-vertically)
- (org-switch-to-buffer-other-window " *Org tags*")
- (and (fboundp 'fit-window-to-buffer)
- (fit-window-to-buffer))))
- ((or (= c ?\C-g)
- (and (= c ?q) (not (rassoc c ntable))))
- (setq quit-flag t))
- ((= c ?\ )
- (setq current "")
- (if exit-after-next (setq exit-after-next 'now)))
- ((= c ?\[) ; clear left
- (org-agenda-query-decompose current)
- (setq current (concat "/" (match-string 2 current)))
- (if exit-after-next (setq exit-after-next 'now)))
- ((= c ?\]) ; clear right
- (org-agenda-query-decompose current)
- (setq current (match-string 1 current))
- (if exit-after-next (setq exit-after-next 'now)))
- ((= c ?\t)
- (condition-case nil
- (setq current (read-string "Query: " current))
- (quit))
- (if exit-after-next (setq exit-after-next 'now)))
- ;; operators
- ((or (= c ?/) (= c ?+)) (setq op "+"))
- ((or (= c ?\;) (= c ?|)) (setq op "|"))
- ((or (= c ?\\) (= c ?-)) (setq op "-"))
- ((= c ?=) (setq op "="))
- ;; todos
- ((setq e (rassoc c todo-table) tg (car e))
- (setq current (org-agenda-query-manip
- current op groups 'todo tg))
- (if exit-after-next (setq exit-after-next 'now)))
- ;; tags
- ((setq e (rassoc c ntable) tg (car e))
- (setq current (org-agenda-query-manip
- current op groups 'tag tg))
- (if exit-after-next (setq exit-after-next 'now))))
- (if (eq exit-after-next 'now) (throw 'exit t))
- (goto-char (point-min))
- (beginning-of-line 1)
- (delete-region (point) (point-at-eol))
- (insert "Query: " current)
- (beginning-of-line 2)
- (delete-region (point) (point-at-eol))
- (org-agenda-query-op-line op)
- (goto-char (point-min)))))
- (if rtn current nil))))
-
-(defun org-agenda-query-op-line (op)
- (insert "Operator: "
- (org-agenda-query-op-entry (equal op "+") "/+" "and")
- (org-agenda-query-op-entry (equal op "|") ";|" "or")
- (org-agenda-query-op-entry (equal op "-") "\\-" "not")
- (org-agenda-query-op-entry (equal op "=") "=" "clear")))
-
-(defun org-agenda-query-op-entry (matchp chars str)
- (if matchp
- (org-add-props (format "[%s %s] " chars (upcase str))
- nil 'face 'org-todo)
- (format "[%s]%s " chars str)))
-
-(defun org-agenda-query-decompose (current)
- (string-match "\\([^/]*\\)/?\\(.*\\)" current))
-
-(defun org-agenda-query-clear (current prefix tag)
- (if (string-match (concat prefix "\\b" (regexp-quote tag) "\\b") current)
- (replace-match "" t t current)
- current))
-
-(defun org-agenda-query-manip (current op groups kind tag)
- "Apply an operator to a query string and a tag.
-CURRENT is the current query string, OP is the operator, GROUPS is a
-list of lists of tags that are mutually exclusive. KIND is 'tag for a
-regular tag, or 'todo for a TODO keyword, and TAG is the tag or
-keyword string."
- ;; If this tag is already in query string, remove it.
- (setq current (org-agenda-query-clear current "[-\\+&|]?" tag))
- (if (equal op "=") current
- ;; When using AND, also remove mutually exclusive tags.
- (if (equal op "+")
- (loop for g in groups do
- (if (member tag g)
- (mapc (lambda (x)
- (setq current
- (org-agenda-query-clear current "\\+" x)))
- g))))
- ;; Decompose current query into q1 (tags) and q2 (TODOs).
- (org-agenda-query-decompose current)
- (let* ((q1 (match-string 1 current))
- (q2 (match-string 2 current)))
- (cond
- ((eq kind 'tag)
- (concat q1 op tag "/" q2))
- ;; It's a TODO; when using AND, drop all other TODOs.
- ((equal op "+")
- (concat q1 "/+" tag))
- (t
- (concat q1 "/" q2 op tag))))))
-
-(defun org-agenda-query-global-todo-keys (&optional files)
- "Return alist of all TODO keywords and their fast keys, in all FILES."
- (let (alist)
- (unless (and files (car files))
- (setq files (org-agenda-files)))
- (save-excursion
- (loop for f in files do
- (set-buffer (find-file-noselect f))
- (loop for k in org-todo-key-alist do
- (setq alist (org-agenda-query-merge-todo-key
- alist k)))))
- alist))
-
-(defun org-agenda-query-merge-todo-key (alist entry)
- (let (e)
- (cond
- ;; if this is not a keyword (:startgroup, etc), ignore it
- ((not (stringp (car entry))))
- ;; if keyword already exists, replace char if it's null
- ((setq e (assoc (car entry) alist))
- (when (null (cdr e)) (setcdr e (cdr entry))))
- ;; if char already exists, prepend keyword but drop char
- ((rassoc (cdr entry) alist)
- (message "TRACE POSITION 2")
- (setq alist (cons (cons (car entry) nil) alist)))
- ;; else, prepend COPY of entry
- (t
- (setq alist (cons (cons (car entry) (cdr entry)) alist)))))
- alist)
-
-(defun org-agenda-query-generic-cmd (op)
- "Activate query manipulation with OP as initial operator."
- (let ((q (org-agenda-query-selection org-agenda-query-string op
- org-tag-alist
- (org-agenda-query-global-todo-keys))))
- (when q
- (setq org-agenda-query-string q)
- (org-agenda-redo))))
-
-(defun org-agenda-query-clear-cmd ()
- "Activate query manipulation, to clear a tag from the string."
- (interactive)
- (org-agenda-query-generic-cmd "="))
-
-(defun org-agenda-query-and-cmd ()
- "Activate query manipulation, initially using the AND (+) operator."
- (interactive)
- (org-agenda-query-generic-cmd "+"))
-
-(defun org-agenda-query-or-cmd ()
- "Activate query manipulation, initially using the OR (|) operator."
- (interactive)
- (org-agenda-query-generic-cmd "|"))
-
-(defun org-agenda-query-not-cmd ()
- "Activate query manipulation, initially using the NOT (-) operator."
- (interactive)
- (org-agenda-query-generic-cmd "-"))
-
-(provide 'org-interactive-query) \ No newline at end of file
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-invoice.el b/.emacs.d/org-7.4/contrib/lisp/org-invoice.el
deleted file mode 100644
index 7e2dad2..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-invoice.el
+++ /dev/null
@@ -1,399 +0,0 @@
-;;; org-invoice.el --- Help manage client invoices in OrgMode
-;;
-;; Copyright (C) 2008 pmade inc. (Peter Jones pjones@pmade.com)
-;;
-;; Permission is hereby granted, free of charge, to any person obtaining
-;; a copy of this software and associated documentation files (the
-;; "Software"), to deal in the Software without restriction, including
-;; without limitation the rights to use, copy, modify, merge, publish,
-;; distribute, sublicense, and/or sell copies of the Software, and to
-;; permit persons to whom the Software is furnished to do so, subject to
-;; the following conditions:
-;;
-;; The above copyright notice and this permission notice shall be
-;; included in all copies or substantial portions of the Software.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
-;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
-;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
-;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-;;
-;; Commentary:
-;;
-;; Building on top of the terrific OrgMode, org-invoice tries to
-;; provide functionality for managing invoices. Currently, it does
-;; this by implementing an OrgMode dynamic block where invoice
-;; information is aggregated so that it can be exported.
-;;
-;; It also provides a library of functions that can be used to collect
-;; this invoice information and use it in other ways, such as
-;; submitting it to on-line invoicing tools.
-;;
-;; I'm already working on an elisp package to submit this invoice data
-;; to the FreshBooks on-line accounting tool.
-;;
-;; Usage:
-;;
-;; In your ~/.emacs:
-;; (autoload 'org-invoice-report "org-invoice")
-;; (autoload 'org-dblock-write:invoice "org-invoice")
-;;
-;; See the documentation in the following functions:
-;;
-;; `org-invoice-report'
-;; `org-dblock-write:invoice'
-;;
-;; Latest version:
-;;
-;; git clone git://pmade.com/elisp
-(eval-when-compile
- (require 'cl)
- (require 'org))
-
-(defgroup org-invoice nil
- "OrgMode Invoice Helper"
- :tag "Org-Invoice" :group 'org)
-
-(defcustom org-invoice-long-date-format "%A, %B %d, %Y"
- "The format string for long dates."
- :type 'string :group 'org-invoice)
-
-(defcustom org-invoice-strip-ts t
- "Remove org timestamps that appear in headings."
- :type 'boolean :group 'org-invoice)
-
-(defcustom org-invoice-default-level 2
- "The heading level at which a new invoice starts. This value
-is used if you don't specify a scope option to the invoice block,
-and when other invoice helpers are trying to find the heading
-that starts an invoice.
-
-The default is 2, assuming that you structure your invoices so
-that they fall under a single heading like below:
-
-* Invoices
-** This is invoice number 1...
-** This is invoice number 2...
-
-If you don't structure your invoices using those conventions,
-change this setting to the number that corresponds to the heading
-at which an invoice begins."
- :type 'integer :group 'org-invoice)
-
-(defcustom org-invoice-start-hook nil
- "Hook called when org-invoice is about to collect data from an
-invoice heading. When this hook is called, point will be on the
-heading where the invoice begins.
-
-When called, `org-invoice-current-invoice' will be set to the
-alist that represents the info for this invoice."
- :type 'hook :group 'org-invoice)
-
- (defcustom org-invoice-heading-hook nil
- "Hook called when org-invoice is collecting data from a
-heading. You can use this hook to add additional information to
-the alist that represents the heading.
-
-When this hook is called, point will be on the current heading
-being processed, and `org-invoice-current-item' will contain the
-alist for the current heading.
-
-This hook is called repeatedly for each invoice item processed."
- :type 'hook :group 'org-invoice)
-
-(defvar org-invoice-current-invoice nil
- "Information about the current invoice.")
-
-(defvar org-invoice-current-item nil
- "Information about the current invoice item.")
-
-(defvar org-invoice-table-params nil
- "The table parameters currently being used.")
-
-(defvar org-invoice-total-time nil
- "The total invoice time for the summary line.")
-
-(defvar org-invoice-total-price nil
- "The total invoice price for the summary line.")
-
-(defconst org-invoice-version "1.0.0"
- "The org-invoice version number.")
-
-(defun org-invoice-goto-tree (&optional tree)
- "Move point to the heading that represents the head of the
-current invoice. The heading level will be taken from
-`org-invoice-default-level' unless tree is set to a string that
-looks like tree2, where the level is 2."
- (let ((level org-invoice-default-level))
- (save-match-data
- (when (and tree (string-match "^tree\\([0-9]+\\)$" tree))
- (setq level (string-to-number (match-string 1 tree)))))
- (org-back-to-heading)
- (while (and (> (org-reduced-level (org-outline-level)) level)
- (org-up-heading-safe)))))
-
-(defun org-invoice-heading-info ()
- "Return invoice information from the current heading."
- (let ((title (org-no-properties (org-get-heading t)))
- (date (org-entry-get nil "TIMESTAMP" 'selective))
- (work (org-entry-get nil "WORK" nil))
- (rate (or (org-entry-get nil "RATE" t) "0"))
- (level (org-outline-level))
- raw-date long-date)
- (unless date (setq date (org-entry-get nil "TIMESTAMP_IA" 'selective)))
- (unless date (setq date (org-entry-get nil "TIMESTAMP" t)))
- (unless date (setq date (org-entry-get nil "TIMESTAMP_IA" t)))
- (unless work (setq work (org-entry-get nil "CLOCKSUM" nil)))
- (unless work (setq work "00:00"))
- (when date
- (setq raw-date (apply 'encode-time (org-parse-time-string date)))
- (setq long-date (format-time-string org-invoice-long-date-format raw-date)))
- (when (and org-invoice-strip-ts (string-match org-ts-regexp-both title))
- (setq title (replace-match "" nil nil title)))
- (when (string-match "^[ \t]+" title)
- (setq title (replace-match "" nil nil title)))
- (when (string-match "[ \t]+$" title)
- (setq title (replace-match "" nil nil title)))
- (setq work (org-hh:mm-string-to-minutes work))
- (setq rate (string-to-number rate))
- (setq org-invoice-current-item (list (cons 'title title)
- (cons 'date date)
- (cons 'raw-date raw-date)
- (cons 'long-date long-date)
- (cons 'work work)
- (cons 'rate rate)
- (cons 'level level)
- (cons 'price (* rate (/ work 60.0)))))
- (run-hook-with-args 'org-invoice-heading-hook)
- org-invoice-current-item))
-
-(defun org-invoice-level-min-max (ls)
- "Return a list where the car is the min level, and the cdr the max."
- (let ((max 0) min level)
- (dolist (info ls)
- (when (cdr (assoc 'date info))
- (setq level (cdr (assoc 'level info)))
- (when (or (not min) (< level min)) (setq min level))
- (when (> level max) (setq max level))))
- (cons (or min 0) max)))
-
-(defun org-invoice-collapse-list (ls)
- "Reorganize the given list by dates."
- (let ((min-max (org-invoice-level-min-max ls)) new)
- (dolist (info ls)
- (let* ((date (cdr (assoc 'date info)))
- (work (cdr (assoc 'work info)))
- (price (cdr (assoc 'price info)))
- (long-date (cdr (assoc 'long-date info)))
- (level (cdr (assoc 'level info)))
- (bucket (cdr (assoc date new))))
- (if (and (/= (car min-max) (cdr min-max))
- (= (car min-max) level)
- (= work 0) (not bucket) date)
- (progn
- (setq info (assq-delete-all 'work info))
- (push (cons 'total-work 0) info)
- (push (cons date (list info)) new)
- (setq bucket (cdr (assoc date new))))
- (when (and date (not bucket))
- (setq bucket (list (list (cons 'date date)
- (cons 'title long-date)
- (cons 'total-work 0)
- (cons 'price 0))))
- (push (cons date bucket) new)
- (setq bucket (cdr (assoc date new))))
- (when (and date bucket)
- (setcdr (assoc 'total-work (car bucket))
- (+ work (cdr (assoc 'total-work (car bucket)))))
- (setcdr (assoc 'price (car bucket))
- (+ price (cdr (assoc 'price (car bucket)))))
- (nconc bucket (list info))))))
- (nreverse new)))
-
-(defun org-invoice-info-to-table (info)
- "Create a single org table row from the given info alist."
- (let ((title (cdr (assoc 'title info)))
- (total (cdr (assoc 'total-work info)))
- (work (cdr (assoc 'work info)))
- (price (cdr (assoc 'price info)))
- (with-price (plist-get org-invoice-table-params :price)))
- (unless total
- (setq
- org-invoice-total-time (+ org-invoice-total-time work)
- org-invoice-total-price (+ org-invoice-total-price price)))
- (setq total (and total (org-minutes-to-hh:mm-string total)))
- (setq work (and work (org-minutes-to-hh:mm-string work)))
- (insert-before-markers
- (concat "|" title
- (cond
- (total (concat "|" total))
- (work (concat "|" work)))
- (and with-price price (concat "|" (format "%.2f" price)))
- "|" "\n"))))
-
-(defun org-invoice-list-to-table (ls)
- "Convert a list of heading info to an org table"
- (let ((with-price (plist-get org-invoice-table-params :price))
- (with-summary (plist-get org-invoice-table-params :summary))
- (with-header (plist-get org-invoice-table-params :headers))
- (org-invoice-total-time 0)
- (org-invoice-total-price 0))
- (insert-before-markers
- (concat "| Task / Date | Time" (and with-price "| Price") "|\n"))
- (dolist (info ls)
- (insert-before-markers "|-\n")
- (mapc 'org-invoice-info-to-table (if with-header (cdr info) (cdr (cdr info)))))
- (when with-summary
- (insert-before-markers
- (concat "|-\n|Total:|"
- (org-minutes-to-hh:mm-string org-invoice-total-time)
- (and with-price (concat "|" (format "%.2f" org-invoice-total-price)))
- "|\n")))))
-
-(defun org-invoice-collect-invoice-data ()
- "Collect all the invoice data from the current OrgMode tree and
-return it. Before you call this function, move point to the
-heading that begins the invoice data, usually using the
-`org-invoice-goto-tree' function."
- (let ((org-invoice-current-invoice
- (list (cons 'point (point)) (cons 'buffer (current-buffer))))
- (org-invoice-current-item nil))
- (save-restriction
- (org-narrow-to-subtree)
- (org-clock-sum)
- (run-hook-with-args 'org-invoice-start-hook)
- (cons org-invoice-current-invoice
- (org-invoice-collapse-list
- (org-map-entries 'org-invoice-heading-info t 'tree 'archive))))))
-
-(defun org-dblock-write:invoice (params)
- "Function called by OrgMode to write the invoice dblock. To
-create an invoice dblock you can use the `org-invoice-report'
-function.
-
-The following parameters can be given to the invoice block (for
-information about dblock parameters, please see the Org manual):
-
-:scope Allows you to override the `org-invoice-default-level'
- variable. The only supported values right now are ones
- that look like :tree1, :tree2, etc.
-
-:prices Set to nil to turn off the price column.
-
-:headers Set to nil to turn off the group headers.
-
-:summary Set to nil to turn off the final summary line."
- (let ((scope (plist-get params :scope))
- (org-invoice-table-params params)
- (zone (move-marker (make-marker) (point)))
- table)
- (unless scope (setq scope 'default))
- (unless (plist-member params :price) (plist-put params :price t))
- (unless (plist-member params :summary) (plist-put params :summary t))
- (unless (plist-member params :headers) (plist-put params :headers t))
- (save-excursion
- (cond
- ((eq scope 'tree) (org-invoice-goto-tree "tree1"))
- ((eq scope 'default) (org-invoice-goto-tree))
- ((symbolp scope) (org-invoice-goto-tree (symbol-name scope))))
- (setq table (org-invoice-collect-invoice-data))
- (goto-char zone)
- (org-invoice-list-to-table (cdr table))
- (goto-char zone)
- (org-table-align)
- (move-marker zone nil))))
-
-(defun org-invoice-in-report-p ()
- "Check to see if point is inside an invoice report."
- (let ((pos (point)) start)
- (save-excursion
- (end-of-line 1)
- (and (re-search-backward "^#\\+BEGIN:[ \t]+invoice" nil t)
- (setq start (match-beginning 0))
- (re-search-forward "^#\\+END:.*" nil t)
- (>= (match-end 0) pos)
- start))))
-
-(defun org-invoice-report (&optional jump)
- "Create or update an invoice dblock report. If point is inside
-an existing invoice report, the report is updated. If point
-isn't inside an invoice report, a new report is created.
-
-When called with a prefix argument, move to the first invoice
-report after point and update it.
-
-For information about various settings for the invoice report,
-see the `org-dblock-write:invoice' function documentation.
-
-An invoice report is created by reading a heading tree and
-collecting information from various properties. It is assumed
-that all invoices start at a second level heading, but this can
-be configured using the `org-invoice-default-level' variable.
-
-Here is an example, where all invoices fall under the first-level
-heading Invoices:
-
-* Invoices
-** Client Foo (Jan 01 - Jan 15)
-*** [2008-01-01 Tue] Built New Server for Production
-*** [2008-01-02 Wed] Meeting with Team to Design New System
-** Client Bar (Jan 01 - Jan 15)
-*** [2008-01-01 Tue] Searched for Widgets on Google
-*** [2008-01-02 Wed] Billed You for Taking a Nap
-
-In this layout, invoices begin at level two, and invoice
-items (tasks) are at level three. You'll notice that each level
-three heading starts with an inactive timestamp. The timestamp
-can actually go anywhere you want, either in the heading, or in
-the text under the heading. But you must have a timestamp
-somewhere so that the invoice report can group your items by
-date.
-
-Properties are used to collect various bits of information for
-the invoice. All properties can be set on the invoice item
-headings, or anywhere in the tree. The invoice report will scan
-up the tree looking for each of the properties.
-
-Properties used:
-
-CLOCKSUM: You can use the Org clock-in and clock-out commands to
- create a CLOCKSUM property. Also see WORK.
-
-WORK: An alternative to the CLOCKSUM property. This property
- should contain the amount of work that went into this
- invoice item formatted as HH:MM (e.g. 01:30).
-
-RATE: Used to calculate the total price for an invoice item.
- Should be the price per hour that you charge (e.g. 45.00).
- It might make more sense to place this property higher in
- the hierarchy than on the invoice item headings.
-
-Using this information, a report is generated that details the
-items grouped by days. For each day you will be able to see the
-total number of hours worked, the total price, and the items
-worked on.
-
-You can place the invoice report anywhere in the tree you want.
-I place mine under a third-level heading like so:
-
-* Invoices
-** An Invoice Header
-*** [2008-11-25 Tue] An Invoice Item
-*** Invoice Report
-#+BEGIN: invoice
-#+END:"
- (interactive "P")
- (let ((report (org-invoice-in-report-p)))
- (when (and (not report) jump)
- (when (re-search-forward "^#\\+BEGIN:[ \t]+invoice" nil t)
- (org-show-entry)
- (beginning-of-line)
- (setq report (point))))
- (if report (goto-char report)
- (org-create-dblock (list :name "invoice")))
- (org-update-dblock)))
-
-(provide 'org-invoice)
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-jira.el b/.emacs.d/org-7.4/contrib/lisp/org-jira.el
deleted file mode 100644
index d224c8f..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-jira.el
+++ /dev/null
@@ -1,65 +0,0 @@
-;;; org-jira.el --- add a jira:ticket protocol to Org
-(defconst org-jira-version "0.1")
-;; Copyright (c)2008 Jonathan Arkell. (by)(nc)(sa) Some rights reserved.
-;; Author: Jonathan Arkell <jonnay@jonnay.net>
-
-;; This file is not part of GNU Emacs.
-
-;; 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 version 2.
-
-;; 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.
-
-;; For a copy of the GNU General Public License, search the Internet,
-;; or write to the Free Software Foundation, Inc., 59 Temple Place,
-;; Suite 330, Boston, MA 02111-1307 USA
-
-;;; Commentary:
-;; This adds a jira protocol to org mode.
-
-;;; Commands:
-;;
-;; Below are complete command list:
-;;
-;;
-;;; Customizable Options:
-;;
-;; Below are customizable option list:
-;;
-
-;; I had initially planned on adding bi-directional linking, so you
-;; could store links from a jira ticket. I also wanted to import
-;; tickets assigned to you as a task. However, I am no longer working
-;; with JIRA, so this is now abandonware.
-
-;;; Installation:
-;; Put org-jira.el somewhere in your load-path.
-;; (Use M-x show-variable RET load-path to see what your load path is.)
-;; Add this to your emacs init file, preferably after you load org mode.
-;(require 'org-jira)
-
-;;; TODO:
-;; - bi-directional links
-;; - deeper importing, like tasks...?
-
-;;; CHANGELOG:
-;; v 0.2 - ran through checkdoc
-;; - Abandoned.
-;; v 0.1 - Initial release
-
-(require 'jira)
-
-(org-add-link-type "jira" 'org-jira-open)
-
-(defun org-jira-open (path)
- "Open a Jira Link from PATH."
- (jira-show-issue path))
-
-
-(provide 'org-jira)
-
-;;; org-jira.el ends here
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-learn.el b/.emacs.d/org-7.4/contrib/lisp/org-learn.el
deleted file mode 100644
index 1078001..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-learn.el
+++ /dev/null
@@ -1,180 +0,0 @@
-;;; org-learn.el --- Implements SuperMemo's incremental learning algorithm
-
-;; Copyright (C) 2009
-;; Free Software Foundation, Inc.
-
-;; Author: John Wiegley <johnw at gnu dot org>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: http://orgmode.org
-;; Version: 6.32trans
-;;
-;; This file is 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:
-
-;; The file implements the learning algorithm described at
-;; http://supermemo.com/english/ol/sm5.htm, which is a system for reading
-;; material according to "spaced repetition". See
-;; http://en.wikipedia.org/wiki/Spaced_repetition for more details.
-;;
-;; To use, turn on state logging and schedule some piece of information you
-;; want to read. Then in the agenda buffer type
-
-(require 'org)
-(eval-when-compile
- (require 'cl))
-
-(defgroup org-learn nil
- "Options concerning the learning code in Org-mode."
- :tag "Org Learn"
- :group 'org-progress)
-
-(defcustom org-learn-always-reschedule nil
- "If non-nil, always reschedule items, even if retention was \"perfect\"."
- :type 'boolean
- :group 'org-learn)
-
-(defcustom org-learn-fraction 0.5
- "Controls the rate at which EF is increased or decreased.
-Must be a number between 0 and 1 (the greater it is the faster
-the changes of the OF matrix)."
- :type 'float
- :group 'org-learn)
-
-(defun initial-optimal-factor (n ef)
- (if (= 1 n)
- 4
- ef))
-
-(defun get-optimal-factor (n ef of-matrix)
- (let ((factors (assoc n of-matrix)))
- (or (and factors
- (let ((ef-of (assoc ef (cdr factors))))
- (and ef-of (cdr ef-of))))
- (initial-optimal-factor n ef))))
-
-(defun set-optimal-factor (n ef of-matrix of)
- (let ((factors (assoc n of-matrix)))
- (if factors
- (let ((ef-of (assoc ef (cdr factors))))
- (if ef-of
- (setcdr ef-of of)
- (push (cons ef of) (cdr factors))))
- (push (cons n (list (cons ef of))) of-matrix)))
- of-matrix)
-
-(defun inter-repetition-interval (n ef &optional of-matrix)
- (let ((of (get-optimal-factor n ef of-matrix)))
- (if (= 1 n)
- of
- (* of (inter-repetition-interval (1- n) ef of-matrix)))))
-
-(defun modify-e-factor (ef quality)
- (if (< ef 1.3)
- 1.3
- (+ ef (- 0.1 (* (- 5 quality) (+ 0.08 (* (- 5 quality) 0.02)))))))
-
-(defun modify-of (of q fraction)
- (let ((temp (* of (+ 0.72 (* q 0.07)))))
- (+ (* (- 1 fraction) of) (* fraction temp))))
-
-(defun calculate-new-optimal-factor (interval-used quality used-of
- old-of fraction)
- "This implements the SM-5 learning algorithm in Lisp.
-INTERVAL-USED is the last interval used for the item in question.
-QUALITY is the quality of the repetition response.
-USED-OF is the optimal factor used in calculation of the last
-interval used for the item in question.
-OLD-OF is the previous value of the OF entry corresponding to the
-relevant repetition number and the E-Factor of the item.
-FRACTION is a number belonging to the range (0,1) determining the
-rate of modifications (the greater it is the faster the changes
-of the OF matrix).
-
-Returns the newly calculated value of the considered entry of the
-OF matrix."
- (let (;; the value proposed for the modifier in case of q=5
- (mod5 (/ (1+ interval-used) interval-used))
- ;; the value proposed for the modifier in case of q=2
- (mod2 (/ (1- interval-used) interval-used))
- ;; the number determining how many times the OF value will
- ;; increase or decrease
- modifier)
- (if (< mod5 1.05)
- (setq mod5 1.05))
- (if (< mod2 0.75)
- (setq mod5 0.75))
- (if (> quality 4)
- (setq modifier (1+ (* (- mod5 1) (- quality 4))))
- (setq modifier (- 1 (* (/ (- 1 mod2) 2) (- 4 quality)))))
- (if (< modifier 0.05)
- (setq modifier 0.05))
- (setq new-of (* used-of modifier))
- (if (> quality 4)
- (if (< new-of old-of)
- (setq new-of old-of)))
- (if (< quality 4)
- (if (> new-of old-of)
- (setq new-of old-of)))
- (setq new-of (+ (* new-of fraction) (* old-of (- 1 fraction))))
- (if (< new-of 1.2)
- (setq new-of 1.2)
- new-of)))
-
-(defvar initial-repetition-state '(-1 1 2.5 nil))
-
-(defun determine-next-interval (n ef quality of-matrix)
- (assert (> n 0))
- (assert (and (>= quality 0) (<= quality 5)))
- (if (< quality 3)
- (list (inter-repetition-interval n ef) (1+ n) ef nil)
- (let ((next-ef (modify-e-factor ef quality)))
- (setq of-matrix
- (set-optimal-factor n next-ef of-matrix
- (modify-of (get-optimal-factor n ef of-matrix)
- quality org-learn-fraction))
- ef next-ef)
- ;; For a zero-based quality of 4 or 5, don't repeat
- (if (and (>= quality 4)
- (not org-learn-always-reschedule))
- (list 0 (1+ n) ef of-matrix)
- (list (inter-repetition-interval n ef of-matrix) (1+ n)
- ef of-matrix)))))
-
-(defun org-smart-reschedule (quality)
- (interactive "nHow well did you remember the information (on a scale of 0-5)? ")
- (let* ((learn-str (org-entry-get (point) "LEARN_DATA"))
- (learn-data (or (and learn-str
- (read learn-str))
- (copy-list initial-repetition-state)))
- closed-dates)
- (setq learn-data
- (determine-next-interval (nth 1 learn-data)
- (nth 2 learn-data)
- quality
- (nth 3 learn-data)))
- (org-entry-put (point) "LEARN_DATA" (prin1-to-string learn-data))
- (if (= 0 (nth 0 learn-data))
- (org-schedule t)
- (org-schedule nil (time-add (current-time)
- (days-to-time (nth 0 learn-data)))))))
-
-(provide 'org-learn)
-
-;; arch-tag: a46bb0e5-e4fb-4004-a9b8-63933c55af33
-
-;;; org-learn.el ends here
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-mac-iCal.el b/.emacs.d/org-7.4/contrib/lisp/org-mac-iCal.el
deleted file mode 100644
index 2510aa7..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-mac-iCal.el
+++ /dev/null
@@ -1,249 +0,0 @@
-;;; org-mac-iCal.el --- Imports events from iCal.app to the Emacs diary
-
-;; Copyright (C) 2009 Christopher Suckling
-
-;; Author: Christopher Suckling <suckling at gmail dot com>
-
-;; This file 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, or (at your option)
-;; any later version.
-
-;; It 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; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;; Version: 0.1057.104
-;; Keywords: outlines, calendar
-
-;;; Commentary:
-;;
-;; This file provides the import of events from Mac OS X 10.5 iCal.app
-;; into the Emacs diary (it is not compatible with OS X < 10.5). The
-;; function org-mac-iCal will import events in all checked iCal.app
-;; calendars for the date range org-mac-iCal-range months, centered
-;; around the current date.
-;;
-;; CAVEAT: This function is destructive; it will overwrite the current
-;; contents of the Emacs diary.
-;;
-;; Installation: add (require 'org-mac-iCal) to your .emacs.
-;;
-;; If you view Emacs diary entries in org-agenda, the following hook
-;; will ensure that all-day events are not orphaned below TODO items
-;; and that any supplementary fields to events (e.g. Location) are
-;; grouped with their parent event
-;;
-;; (add-hook 'org-agenda-cleanup-fancy-diary-hook
-;; (lambda ()
-;; (goto-char (point-min))
-;; (save-excursion
-;; (while (re-search-forward "^[a-z]" nil t)
-;; (goto-char (match-beginning 0))
-;; (insert "0:00-24:00 ")))
-;; (while (re-search-forward "^ [a-z]" nil t)
-;; (goto-char (match-beginning 0))
-;; (save-excursion
-;; (re-search-backward "^[0-9]+:[0-9]+-[0-9]+:[0-9]+ " nil t))
-;; (insert (match-string 0)))))
-
-;;; Code:
-
-(defcustom org-mac-iCal-range 2
- "The range in months to import iCal.app entries into the Emacs
-diary. The import is centered around today's date; thus a value
-of 2 imports entries for one month before and one month after
-today's date"
- :group 'org-time
- :type 'integer)
-
-(defun org-mac-iCal ()
- "Selects checked calendars in iCal.app and imports them into
-the the Emacs diary"
- (interactive)
-
- ;; kill diary buffers then empty diary files to avoid duplicates
- (setq currentBuffer (buffer-name))
- (setq openBuffers (mapcar (function buffer-name) (buffer-list)))
- (omi-kill-diary-buffer openBuffers)
- (with-temp-buffer
- (insert-file-contents diary-file)
- (delete-region (point-min) (point-max))
- (write-region (point-min) (point-max) diary-file))
-
- ;; determine available calendars
- (setq caldav-folders (directory-files "~/Library/Calendars" 1 ".*caldav$"))
- (setq caldav-calendars nil)
- (mapc
- (lambda (x)
- (setq caldav-calendars (nconc caldav-calendars (directory-files x 1 ".*calendar$"))))
- caldav-folders)
-
- (setq local-calendars nil)
- (setq local-calendars (directory-files "~/Library/Calendars" 1 ".*calendar$"))
-
- (setq all-calendars (append caldav-calendars local-calendars))
-
- ;; parse each calendar's Info.plist to see if calendar is checked in iCal
- (setq all-calendars (delq 'nil (mapcar
- (lambda (x)
- (omi-checked x))
- all-calendars)))
-
- ;; for each calendar, concatenate individual events into a single ics file
- (with-temp-buffer
- (shell-command "sw_vers" (current-buffer))
- (when (re-search-backward "10\\.[56]" nil t)
- (omi-concat-leopard-ics all-calendars)))
-
- ;; move all caldav ics files to the same place as local ics files
- (mapc
- (lambda (x)
- (mapc
- (lambda (y)
- (rename-file (concat x "/" y);
- (concat "~/Library/Calendars/" y)))
- (directory-files x nil ".*ics$")))
- caldav-folders)
-
- ;; check calendar has contents and import
- (setq import-calendars (directory-files "~/Library/Calendars" 1 ".*ics$"))
- (mapc
- (lambda (x)
- (when (/= (nth 7 (file-attributes x 'string)) 0)
- (omi-import-ics x)))
- import-calendars)
-
- ;; tidy up intermediate files and buffers
- (setq usedCalendarsBuffers (mapcar (function buffer-name) (buffer-list)))
- (omi-kill-ics-buffer usedCalendarsBuffers)
- (setq usedCalendarsFiles (directory-files "~/Library/Calendars" 1 ".*ics$"))
- (omi-delete-ics-file usedCalendarsFiles)
-
- (switch-to-buffer currentBuffer))
-
-(defun omi-concat-leopard-ics (list)
- "Leopard stores each iCal.app event in a separate ics file.
-Whilst useful for Spotlight indexing, this is less helpful for
-icalendar-import-file. omi-concat-leopard-ics concatenates these
-individual event files into a single ics file"
- (mapc
- (lambda (x)
- (setq omi-leopard-events (directory-files (concat x "/Events") 1 ".*ics$"))
- (with-temp-buffer
- (mapc
- (lambda (y)
- (insert-file-contents (expand-file-name y)))
- omi-leopard-events)
- (write-region (point-min) (point-max) (concat (expand-file-name x) ".ics"))))
- list))
-
-(defun omi-import-ics (string)
- "Imports an ics file into the Emacs diary. First tidies up the
-ics file so that it is suitable for import and selects a sensible
-date range so that Emacs calendar view doesn't grind to a halt"
- (with-temp-buffer
- (insert-file-contents string)
- (goto-char (point-min))
- (while
- (re-search-forward "^BEGIN:VCALENDAR$" nil t)
- (setq startEntry (match-beginning 0))
- (re-search-forward "^END:VCALENDAR$" nil t)
- (setq endEntry (match-end 0))
- (save-restriction
- (narrow-to-region startEntry endEntry)
- (goto-char (point-min))
- (re-search-forward "\\(^DTSTART;.*:\\)\\([0-9][0-9][0-9][0-9]\\)\\([0-9][0-9]\\)" nil t)
- (if (or (eq (match-string 2) nil) (eq (match-string 3) nil))
- (progn
- (setq yearEntry 0)
- (setq monthEntry 0))
- (setq yearEntry (string-to-number (match-string 2)))
- (setq monthEntry (string-to-number (match-string 3))))
- (setq year (string-to-number (format-time-string "%Y")))
- (setq month (string-to-number (format-time-string "%m")))
- (when (or
- (and
- (= yearEntry year)
- (or (< monthEntry (- month (/ org-mac-iCal-range 2))) (> monthEntry (+ month (/ org-mac-iCal-range 2)))))
- (< yearEntry (- year 1))
- (> yearEntry (+ year 1))
- (and
- (= yearEntry (- year 1)) (/= monthEntry 12))
- (and
- (= yearEntry (+ year 1)) (/= monthEntry 1)))
- (delete-region startEntry endEntry))))
- (while
- (re-search-forward "^END:VEVENT$" nil t)
- (delete-blank-lines))
- (goto-line 1)
- (insert "BEGIN:VCALENDAR\n\n")
- (goto-line 2)
- (while
- (re-search-forward "^BEGIN:VCALENDAR$" nil t)
- (replace-match "\n"))
- (goto-line 2)
- (while
- (re-search-forward "^END:VCALENDAR$" nil t)
- (replace-match "\n"))
- (insert "END:VCALENDAR")
- (goto-line 1)
- (delete-blank-lines)
- (while
- (re-search-forward "^END:VEVENT$" nil t)
- (delete-blank-lines))
- (goto-line 1)
- (while
- (re-search-forward "^ORG.*" nil t)
- (replace-match "\n"))
- (goto-line 1)
- (write-region (point-min) (point-max) string))
-
- (icalendar-import-file string diary-file))
-
-(defun omi-kill-diary-buffer (list)
- (mapc
- (lambda (x)
- (if (string-match "^diary" x)
- (kill-buffer x)))
- list))
-
-(defun omi-kill-ics-buffer (list)
- (mapc
- (lambda (x)
- (if (string-match "ics$" x)
- (kill-buffer x)))
- list))
-
-(defun omi-delete-ics-file (list)
- (mapc
- (lambda (x)
- (delete-file x))
- list))
-
-(defun omi-checked (directory)
- "Parse Info.plist in iCal.app calendar folder and determine
-whether Checked key is 1. If Checked key is not 1, remove
-calendar from list of calendars for import"
- (let* ((root (xml-parse-file (car (directory-files directory 1 "Info.plist"))))
- (plist (car root))
- (dict (car (xml-get-children plist 'dict)))
- (keys (cdr (xml-node-children dict)))
- (keys (mapcar
- (lambda (x)
- (cond ((listp x)
- x)))
- keys))
- (keys (delq 'nil keys)))
- (when (equal "1" (car (cddr (lax-plist-get keys '(key nil "Checked")))))
- directory)))
-
-(provide 'org-mac-iCal)
-
-;;; org-mac-iCal.el ends here
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-mac-link-grabber.el b/.emacs.d/org-7.4/contrib/lisp/org-mac-link-grabber.el
deleted file mode 100644
index 8ec428b..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-mac-link-grabber.el
+++ /dev/null
@@ -1,465 +0,0 @@
-;;; org-mac-link-grabber.el --- Grab links and url from various mac
-;;; application and insert them as links into org-mode documents
-;;
-;; Copyright (c) 2010 Free Software Foundation, Inc.
-;;
-;; Author: Anthony Lander <anthony.lander@gmail.com>
-;; Version: 1.0.1
-;; Keywords: org, mac, hyperlink
-;;
-;; 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 3, 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, write to the Free Software
-;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-;;
-;;; Commentary:
-;;
-;; This code allows you to grab either the current selected items, or
-;; the frontmost url in various mac appliations, and insert them as
-;; hyperlinks into the current org-mode document at point.
-;;
-;; This code is heavily based on, and indeed requires,
-;; org-mac-message.el written by John Weigley and Christopher
-;; Suckling.
-;;
-;; Detailed comments for each application interface are inlined with
-;; the code. Here is a brief overview of how the code interacts with
-;; each application:
-;;
-;; Finder.app - grab links to the selected files in the frontmost window
-;; Mail.app - grab links to the selected messages in the message list
-;; AddressBook.app - Grab links to the selected addressbook Cards
-;; Firefox.app - Grab the url of the frontmost tab in the frontmost window
-;; Vimperator/Firefox.app - Grab the url of the frontmost tab in the frontmost window
-;; Safari.app - Grab the url of the frontmost tab in the frontmost window
-;; Google Chrome.app - Grab the url of the frontmost tab in the frontmost window
-;; Together.app - Grab links to the selected items in the library list
-;;
-;;
-;; Installation:
-;;
-;; add (require 'org-mac-link-grabber) to your .emacs, and optionally
-;; bind a key to activate the link grabber menu, like this:
-;;
-;; (add-hook 'org-mode-hook (lambda ()
-;; (define-key org-mode-map (kbd "C-c g") 'omlg-grab-link)))
-;;
-;;
-;; Usage:
-;;
-;; Type C-c g (or whatever key you defined, as above), or type M-x
-;; omlg-grab-link RET to activate the link grabber. This will present
-;; you with a menu to choose an application from which to grab a link
-;; to insert at point. You may also type C-g to abort.
-;;
-;; Customizing:
-;;
-;; You may customize which applications appear in the grab menu by
-;; customizing the group org-mac-link-grabber. Changes take effect
-;; immediately.
-;;
-;;
-;;; Code:
-
-(require 'org)
-(require 'org-mac-message)
-
-(defgroup org-mac-link-grabber nil
- "Options concerning grabbing links from external Mac
-applications and inserting them in org documents"
- :tag "Org Mac link grabber"
- :group 'org-link)
-
-(defcustom org-mac-grab-Finder-app-p t
- "Enable menu option [F]inder to grab links from the Finder"
- :tag "Grab Finder.app links"
- :group 'org-mac-link-grabber
- :type 'boolean)
-
-(defcustom org-mac-grab-Mail-app-p t
- "Enable menu option [m]ail to grab links from Mail.app"
- :tag "Grab Mail.app links"
- :group 'org-mac-link-grabber
- :type 'boolean)
-
-(defcustom org-mac-grab-Addressbook-app-p t
- "Enable menu option [a]ddressbook to grab links from AddressBook.app"
- :tag "Grab AddressBook.app links"
- :group 'org-mac-link-grabber
- :type 'boolean)
-
-(defcustom org-mac-grab-Safari-app-p t
- "Enable menu option [s]afari to grab links from Safari.app"
- :tag "Grab Safari.app links"
- :group 'org-mac-link-grabber
- :type 'boolean)
-
-(defcustom org-mac-grab-Firefox-app-p t
- "Enable menu option [f]irefox to grab links from Firefox.app"
- :tag "Grab Firefox.app links"
- :group 'org-mac-link-grabber
- :type 'boolean)
-
-(defcustom org-mac-grab-Firefox+Vimperator-p nil
- "Enable menu option [v]imperator to grab links from Firefox.app running the Vimperator plugin"
- :tag "Grab Vimperator/Firefox.app links"
- :group 'org-mac-link-grabber
- :type 'boolean)
-
-(defcustom org-mac-grab-Chrome-app-p t
- "Enable menu option [f]irefox to grab links from Google Chrome.app"
- :tag "Grab Google Chrome.app links"
- :group 'org-mac-link-grabber
- :type 'boolean)
-
-(defcustom org-mac-grab-Together-app-p nil
- "Enable menu option [t]ogether to grab links from Together.app"
- :tag "Grab Together.app links"
- :group 'org-mac-link-grabber
- :type 'boolean)
-
-
-(defun omlg-grab-link ()
- "Prompt the user for an application to grab a link from, then go grab the link, and insert it at point"
- (interactive)
- (let* ((descriptors `(("F" "inder" org-mac-finder-insert-selected ,org-mac-grab-Finder-app-p)
- ("m" "ail" org-mac-message-insert-selected ,org-mac-grab-Mail-app-p)
- ("a" "ddressbook" org-mac-addressbook-insert-selected ,org-mac-grab-Addressbook-app-p)
- ("s" "afari" org-mac-safari-insert-frontmost-url ,org-mac-grab-Safari-app-p)
- ("f" "irefox" org-mac-firefox-insert-frontmost-url ,org-mac-grab-Firefox-app-p)
- ("v" "imperator" org-mac-vimperator-insert-frontmost-url ,org-mac-grab-Firefox+Vimperator-p)
- ("c" "hrome" org-mac-chrome-insert-frontmost-url ,org-mac-grab-Chrome-app-p)
- ("t" "ogether" org-mac-together-insert-selected ,org-mac-grab-Together-app-p)))
- (menu-string (make-string 0 ?x))
- input)
-
- ;; Create the menu string for the keymap
- (mapc '(lambda (descriptor)
- (when (elt descriptor 3)
- (setf menu-string (concat menu-string "[" (elt descriptor 0) "]" (elt descriptor 1) " "))))
- descriptors)
- (setf (elt menu-string (- (length menu-string) 1)) ?:)
-
- ;; Prompt the user, and grab the link
- (message menu-string)
- (setq input (read-char-exclusive))
- (mapc '(lambda (descriptor)
- (let ((key (elt (elt descriptor 0) 0))
- (active (elt descriptor 3))
- (grab-function (elt descriptor 2)))
- (when (and active (eq input key))
- (call-interactively grab-function))))
- descriptors)))
-
-(defalias 'omgl-grab-link 'omlg-grab-link
- "Renamed, and this alias will be obsolete next revision.")
-
-(defun org-mac-paste-applescript-links (as-link-list)
- "Paste in a list of links from an applescript handler. The
- links are of the form <link>::split::<name>"
- (let* ((link-list
- (mapcar
- (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) (setq x (match-string 1 x))) x)
- (split-string as-link-list "[\r\n]+")))
- split-link URL description orglink orglink-insert rtn orglink-list)
- (while link-list
- (setq split-link (split-string (pop link-list) "::split::"))
- (setq URL (car split-link))
- (setq description (cadr split-link))
- (when (not (string= URL ""))
- (setq orglink (org-make-link-string URL description))
- (push orglink orglink-list)))
- (setq rtn (mapconcat 'identity orglink-list "\n"))
- (kill-new rtn)
- rtn))
-
-
-
-;; Handle links from Firefox.app
-;;
-;; This code allows you to grab the current active url from the main
-;; Firefox.app window, and insert it as a link into an org-mode
-;; document. Unfortunately, firefox does not expose an applescript
-;; dictionary, so this is necessarily introduces some limitations.
-;;
-;; The applescript to grab the url from Firefox.app uses the System
-;; Events application to give focus to the firefox application, select
-;; the contents of the url bar, and copy it. It then uses the title of
-;; the window as the text of the link. There is no way to grab links
-;; from other open tabs, and further, if there is more than one window
-;; open, it is not clear which one will be used (though emperically it
-;; seems that it is always the last active window).
-
-(defun as-mac-firefox-get-frontmost-url ()
- (let ((result (do-applescript
- (concat
- "set oldClipboard to the clipboard\n"
- "set frontmostApplication to path to frontmost application\n"
- "tell application \"Firefox\"\n"
- " activate\n"
- " delay 0.15\n"
- " tell application \"System Events\"\n"
- " keystroke \"l\" using command down\n"
- " keystroke \"c\" using command down\n"
- " end tell\n"
- " delay 0.15\n"
- " set theUrl to the clipboard\n"
- " set the clipboard to oldClipboard\n"
- " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
- "end tell\n"
- "activate application (frontmostApplication as text)\n"
- "set links to {}\n"
- "copy theResult to the end of links\n"
- "return links as string\n"))))
- (car (split-string result "[\r\n]+" t))))
-
-(defun org-mac-firefox-get-frontmost-url ()
- (interactive)
- (message "Applescript: Getting Firefox url...")
- (let* ((url-and-title (as-mac-firefox-get-frontmost-url))
- (split-link (split-string url-and-title "::split::"))
- (URL (car split-link))
- (description (cadr split-link))
- (org-link))
- (when (not (string= URL ""))
- (setq org-link (org-make-link-string URL description)))
- (kill-new org-link)
- org-link))
-
-(defun org-mac-firefox-insert-frontmost-url ()
- (interactive)
- (insert (org-mac-firefox-get-frontmost-url)))
-
-
-;; Handle links from Google Firefox.app running the Vimperator extension
-;; Grab the frontmost url from Firefox+Vimperator. Same limitations are
-;; Firefox
-
-(defun as-mac-vimperator-get-frontmost-url ()
- (let ((result (do-applescript
- (concat
- "set oldClipboard to the clipboard\n"
- "set frontmostApplication to path to frontmost application\n"
- "tell application \"Firefox\"\n"
- " activate\n"
- " delay 0.15\n"
- " tell application \"System Events\"\n"
- " keystroke \"y\"\n"
- " end tell\n"
- " delay 0.15\n"
- " set theUrl to the clipboard\n"
- " set the clipboard to oldClipboard\n"
- " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
- "end tell\n"
- "activate application (frontmostApplication as text)\n"
- "set links to {}\n"
- "copy theResult to the end of links\n"
- "return links as string\n"))))
- (replace-regexp-in-string "\s+-\s+Vimperator" "" (car (split-string result "[\r\n]+" t)))))
-
-
-(defun org-mac-vimperator-get-frontmost-url ()
- (interactive)
- (message "Applescript: Getting Vimperator url...")
- (let* ((url-and-title (as-mac-vimperator-get-frontmost-url))
- (split-link (split-string url-and-title "::split::"))
- (URL (car split-link))
- (description (cadr split-link))
- (org-link))
- (when (not (string= URL ""))
- (setq org-link (org-make-link-string URL description)))
- (kill-new org-link)
- org-link))
-
-(defun org-mac-vimperator-insert-frontmost-url ()
- (interactive)
- (insert (org-mac-vimperator-get-frontmost-url)))
-
-
-;; Handle links from Google Chrome.app
-;; Grab the frontmost url from Google Chrome. Same limitations are
-;; Firefox because Chrome doesn't publish an Applescript dictionary
-
-(defun as-mac-chrome-get-frontmost-url ()
- (let ((result (do-applescript
- (concat
- "set oldClipboard to the clipboard\n"
- "set frontmostApplication to path to frontmost application\n"
- "tell application \"Google Chrome\"\n"
- " activate\n"
- " delay 0.15\n"
- " tell application \"System Events\"\n"
- " keystroke \"l\" using command down\n"
- " keystroke \"c\" using command down\n"
- " end tell\n"
- " delay 0.15\n"
- " set theUrl to the clipboard\n"
- " set the clipboard to oldClipboard\n"
- " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
- "end tell\n"
- "activate application (frontmostApplication as text)\n"
- "set links to {}\n"
- "copy theResult to the end of links\n"
- "return links as string\n"))))
- (car (split-string result "[\r\n]+" t))))
-
-(defun org-mac-chrome-get-frontmost-url ()
- (interactive)
- (message "Applescript: Getting Chrome url...")
- (let* ((url-and-title (as-mac-chrome-get-frontmost-url))
- (split-link (split-string url-and-title "::split::"))
- (URL (car split-link))
- (description (cadr split-link))
- (org-link))
- (when (not (string= URL ""))
- (setq org-link (org-make-link-string URL description)))
- (kill-new org-link)
- org-link))
-
-(defun org-mac-chrome-insert-frontmost-url ()
- (interactive)
- (insert (org-mac-chrome-get-frontmost-url)))
-
-
-;; Handle links from Safari.app
-;; Grab the frontmost url from Safari.
-
-(defun as-mac-safari-get-frontmost-url ()
- (let ((result (do-applescript
- (concat
- "tell application \"Safari\"\n"
- " set theUrl to URL of document 1\n"
- " set theName to the name of the document 1\n"
- " return theUrl & \"::split::\" & theName & \"\n\"\n"
- "end tell\n"))))
- (car (split-string result "[\r\n]+" t))))
-
-(defun org-mac-safari-get-frontmost-url ()
- (interactive)
- (message "Applescript: Getting Safari url...")
- (let* ((url-and-title (as-mac-safari-get-frontmost-url))
- (split-link (split-string url-and-title "::split::"))
- (URL (car split-link))
- (description (cadr split-link))
- (org-link))
- (when (not (string= URL ""))
- (setq org-link (org-make-link-string URL description)))
- (kill-new org-link)
- org-link))
-
-(defun org-mac-safari-insert-frontmost-url ()
- (interactive)
- (insert (org-mac-safari-get-frontmost-url)))
-
-
-;;
-;;
-;; Handle links from together.app
-;;
-;;
-
-(org-add-link-type "x-together-item" 'org-mac-together-item-open)
-
-(defun org-mac-together-item-open (uid)
- "Open the given uid, which is a reference to an item in Together"
- (shell-command (concat "open -a Together \"x-together-item:" uid "\"")))
-
-(defun as-get-selected-together-items ()
- (do-applescript
- (concat
- "tell application \"Together\"\n"
- " set theLinkList to {}\n"
- " set theSelection to selected items\n"
- " repeat with theItem in theSelection\n"
- " set theLink to (get item link of theItem) & \"::split::\" & (get name of theItem) & \"\n\"\n"
- " copy theLink to end of theLinkList\n"
- " end repeat\n"
- " return theLinkList as string\n"
- "end tell")))
-
-(defun org-mac-together-get-selected ()
- (interactive)
- (message "Applescript: Getting Togther items...")
- (org-mac-paste-applescript-links (as-get-selected-together-items)))
-
-(defun org-mac-together-insert-selected ()
- (interactive)
- (insert (org-mac-together-get-selected)))
-
-
-;;
-;;
-;; Handle links from Finder.app
-;;
-;;
-
-(defun as-get-selected-finder-items ()
- (do-applescript
-(concat
-"tell application \"Finder\"\n"
-" set theSelection to the selection\n"
-" set links to {}\n"
-" repeat with theItem in theSelection\n"
-" set theLink to \"file://\" & (POSIX path of (theItem as string)) & \"::split::\" & (get the name of theItem) & \"\n\"\n"
-" copy theLink to the end of links\n"
-" end repeat\n"
-" return links as string\n"
-"end tell\n")))
-
-(defun org-mac-finder-item-get-selected ()
- (interactive)
- (message "Applescript: Getting Finder items...")
- (org-mac-paste-applescript-links (as-get-selected-finder-items)))
-
-(defun org-mac-finder-insert-selected ()
- (interactive)
- (insert (org-mac-finder-item-get-selected)))
-
-
-;;
-;;
-;; Handle links from AddressBook.app
-;;
-;;
-
-(org-add-link-type "addressbook" 'org-mac-addressbook-item-open)
-
-(defun org-mac-addressbook-item-open (uid)
- "Open the given uid, which is a reference to an item in Together"
- (shell-command (concat "open \"addressbook:" uid "\"")))
-
-(defun as-get-selected-addressbook-items ()
- (do-applescript
- (concat
- "tell application \"Address Book\"\n"
- " set theSelection to the selection\n"
- " set links to {}\n"
- " repeat with theItem in theSelection\n"
- " set theLink to \"addressbook://\" & (the id of theItem) & \"::split::\" & (the name of theItem) & \"\n\"\n"
- " copy theLink to the end of links\n"
- " end repeat\n"
- " return links as string\n"
- "end tell\n")))
-
-(defun org-mac-addressbook-item-get-selected ()
- (interactive)
- (message "Applescript: Getting Address Book items...")
- (org-mac-paste-applescript-links (as-get-selected-addressbook-items)))
-
-(defun org-mac-addressbook-insert-selected ()
- (interactive)
- (insert (org-mac-addressbook-item-get-selected)))
-
-
-(provide 'org-mac-link-grabber)
-
-;;; org-mac-link-grabber.el ends here
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-mairix.el b/.emacs.d/org-7.4/contrib/lisp/org-mairix.el
deleted file mode 100644
index 1f62b95..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-mairix.el
+++ /dev/null
@@ -1,332 +0,0 @@
-;;; org-mairix.el - Support for hooking mairix search into Org for different MUAs
-;;
-;; Copyright (C) 2007 Georg C. F. Greve
-;; mutt support by Adam Spiers <orgmode at adamspiers dot org>
-;;
-;; Author: Georg C. F. Greve <greve at fsfeurope dot org>
-;; Keywords: outlines, hypermedia, calendar, wp, email, mairix
-;; Purpose: Integrate mairix email searching into Org mode
-;; See http://orgmode.org and http://www.rpcurnow.force9.co.uk/mairix/
-;; Version: 0.5
-;;
-;; This file 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, or (at your option)
-;; any later version.
-
-;; It 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; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; USAGE NOTE
-;;
-;; You will need to configure mairix first, which involves setting up your
-;; .mairixrc in your home directory. Once it is working, you should set up
-;; your way to display results in your favorite way -- usually a MUA.
-;; Currently gnus and mutt are supported.
-;;
-;; After both steps are done, all you should need to hook mairix, org
-;; and your MUA together is to do (require 'org-mairix) in your
-;; startup file. Everything can then be configured normally through
-;; Emacs customisation.
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(require 'org)
-
-;;; The custom variables
-
-(defgroup org-mairix nil
- "Mairix support/integration in org."
- :tag "Org Mairix"
- :group 'org)
-
-(defcustom org-mairix-threaded-links t
- "Should new links be created as threaded links?
-If t, links will be stored as threaded searches.
-If nil, links will be stored as non-threaded searches."
- :group 'org-mairix
- :type 'boolean)
-
-(defcustom org-mairix-augmented-links nil
- "Should new links be created as augmenting searches?
-If t, links will be stored as augmenting searches.
-If nil, links will be stored as normal searches.
-
-Attention: When activating this option, you will need
-to remove old articles from your mairix results group
-in some other way, mairix will not do it for you."
- :group 'org-mairix
- :type 'boolean)
-
-(defcustom org-mairix-display-hook 'org-mairix-gnus-display-results
- "Hook to call to display the results of a successful mairix search.
-Defaults to Gnus, feel free to add your own MUAs or methods."
- :group 'org-mairix
- :type 'hook)
-
-(defcustom org-mairix-open-command "mairix %args% '%search%'"
- "The mairix command-line to use. If your paths are set up
-correctly, you should not need to change this.
-
-'%search%' will get substituted with the search expression, and
-'%args%' with any additional arguments."
- :group 'org-mairix
- :type 'string)
-
-;;; The hooks to integrate mairix into org
-
-(org-add-link-type "mairix" 'org-mairix-open)
-(add-hook 'org-store-link-functions 'org-mairix-store-gnus-link)
-
-;;; Generic org-mairix functions
-
-(defun org-mairix-construct-link (message-id)
- "Construct a mairix: hyperlink based on message-id."
- (concat "mairix:"
- (if org-mairix-threaded-links "t:")
- (if org-mairix-augmented-links "a:")
- "@@"
- (org-remove-angle-brackets message-id)))
-
-(defun org-store-mairix-link-props (&rest plist)
- "Take a property list describing a mail, and add mairix link
-and description properties so that org can build a mairix link to
-it."
- ;; We have to call `org-store-link-props' twice:
- ;;
- ;; - It extracts 'fromname'/'fromaddress' from 'from' property,
- ;; and stores the updated plist to `org-store-link-plist'.
- ;;
- ;; - `org-email-link-description' uses these new properties to
- ;; build a description from the previously stored plist. I
- ;; wrote a tiny patch to `org-email-link-description' so it
- ;; could take a non-stored plist as an optional 2nd argument,
- ;; but the plist provided still needs 'fromname'/'fromaddress'.
- ;;
- ;; - Ideally we would decouple the storing bit of
- ;; `org-store-link-props' from the extraction bit, but lots of
- ;; stuff in `org-store-link' which calls it would need to be
- ;; changed. Maybe just factor out the extraction so it can be
- ;; reused separately?
- (let ((mid (plist-get plist :message-id)))
- (apply 'org-store-link-props
- (append plist
- (list :type "mairix"
- :link (org-mairix-construct-link mid))))
- (apply 'org-store-link-props
- (append org-store-link-plist
- (list :description (org-email-link-description))))))
-
-(defun org-mairix-message-send-and-exit-with-link ()
- "Function that can be assigned as an alternative sending function,
-it sends the message and then stores a mairix link to it before burying
-the buffer just like 'message-send-and-exit' does."
- (interactive)
- (message-send)
- (let* ((message-id (message-fetch-field "Message-Id"))
- (subject (message-fetch-field "Subject"))
- (link (org-mairix-construct-link message-id))
- (desc (concat "Email: '" subject "'")))
- (setq org-stored-links
- (cons (list link desc) org-stored-links)))
- (message-bury (current-buffer)))
-
-(defun org-mairix-open (search)
- "Function to open mairix link.
-
-We first need to split it into its individual parts, and then
-extract the message-id to be passed on to the display function
-before call mairix, evaluate the number of matches returned, and
-make sure to only call display of mairix succeeded in matching."
- (let* ((args ""))
- (if (equal (substring search 0 2) "t:" )
- (progn (setq search (substring search 2 nil))
- (setq args (concat args " --threads"))))
- (if (equal (substring search 0 2) "a:")
- (progn (setq search (substring search 2 nil))
- (setq args (concat args " --augment"))))
- (let ((cmdline (org-mairix-command-substitution
- org-mairix-open-command search args)))
- (print cmdline)
- (setq retval (shell-command-to-string cmdline))
- (string-match "\[0-9\]+" retval)
- (setq matches (string-to-number (match-string 0 retval)))
- (if (eq matches 0) (message "Link failed: no matches, sorry")
- (message "Link returned %d matches" matches)
- (run-hook-with-args 'org-mairix-display-hook search args)))))
-
-(defun org-mairix-command-substitution (cmd search args)
- "Substitute '%search%' and '%args% in mairix search command."
- (while (string-match "%search%" cmd)
- (setq cmd (replace-match search 'fixedcase 'literal cmd)))
- (while (string-match "%args%" cmd)
- (setq cmd (replace-match args 'fixedcase 'literal cmd)))
- cmd)
-
-;;; Functions necessary for integration of external MUAs.
-
-;; Of course we cannot call `org-store-link' from within an external
-;; MUA, so we need some other way of storing a link for later
-;; retrieval by org-mode and/or remember-mode. To do this we use a
-;; temporary file as a kind of dedicated clipboard.
-
-(defcustom org-mairix-link-clipboard "~/.org-mairix-link"
- "Pseudo-clipboard file where mairix URLs get copied to by external
-applications in order to mimic `org-store-link'. Used by
-`org-mairix-insert-link'."
- :group 'org-mairix
- :type 'string)
-
-;; When we resolve some of the issues with `org-store-link' detailed
-;; at <http://thread.gmane.org/gmane.emacs.orgmode/4217/focus=4635>,
-;; we might not need org-mairix-insert-link.
-
-(defun org-mairix-insert-link ()
- "Insert link from file defined by `org-mairix-link-clipboard'."
- (interactive)
- (let ((bytes (cadr (insert-file-contents
- (expand-file-name org-mairix-link-clipboard)))))
- (forward-char bytes)
- (save-excursion
- (forward-char -1)
- (if (looking-at "\n")
- (delete-char 1)))))
-
-;;; Functions necessary for mutt integration
-
-(defgroup org-mairix-mutt nil
- "Use mutt for mairix support in org."
- :tag "Org Mairix Mutt"
- :group 'org-mairix)
-
-(defcustom org-mairix-mutt-display-command
- "xterm -title 'mairix search: %search%' -e 'unset COLUMNS; mutt -f
-~/mail/mairix -e \"push <display-message>\"' &"
- "Command to execute to display mairix search results via mutt within
-an xterm.
-
-'%search%' will get substituted with the search expression, and
-'%args%' with any additional arguments used in the search."
- :group 'org-mairix-mutt
- :type 'string)
-
-(defun org-mairix-mutt-display-results (search args)
- "Display results of mairix search in mutt, using the command line
-defined in `org-mairix-mutt-display-command'."
- ;; By default, async `shell-command' invocations display the temp
- ;; buffer, which is annoying here. We choose a deterministic
- ;; buffer name so we can hide it again immediately.
- ;; Note: `call-process' is synchronous so not useful here.
- (let ((cmd (org-mairix-command-substitution
- org-mairix-mutt-display-command search args))
- (tmpbufname (generate-new-buffer-name " *mairix-view*")))
- (shell-command cmd tmpbufname)
- (delete-windows-on (get-buffer tmpbufname))))
-
-;;; Functions necessary for gnus integration
-
-(defgroup org-mairix-gnus nil
- "Use gnus for mairix support in org."
- :tag "Org Mairix Gnus"
- :group 'org-mairix)
-
-(defcustom org-mairix-gnus-results-group "nnmaildir:mairix"
- "The group that is configured to hold the mairix search results,
-which needs to be setup independently of the org-mairix integration,
-along with general mairix configuration."
- :group 'org-mairix-gnus
- :type 'string)
-
-(defcustom org-mairix-gnus-select-display-group-function
-'org-mairix-gnus-select-display-group-function-gg
- "Hook to call to select the group that contains the matching articles.
-We should not need this, it is owed to a problem of gnus that people were
-not yet able to figure out, see
- http://article.gmane.org/gmane.emacs.gnus.general/65248
- http://article.gmane.org/gmane.emacs.gnus.general/65265
- http://article.gmane.org/gmane.emacs.gnus.user/9596
-for reference.
-
-It seems gnus needs a 'forget/ignore everything you think you
-know about that group' function. Volunteers?"
- :group 'org-mairix-gnus
- :type 'hook)
-
-(defun org-mairix-store-gnus-link ()
- "Store a link to the current gnus message as a Mairix search for its
-Message ID."
-
- ;; gnus integration
- (when (memq major-mode '(gnus-summary-mode gnus-article-mode))
- (and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary))
- (let* ((article (gnus-summary-article-number))
- (header (gnus-summary-article-header article))
- (from (mail-header-from header))
- (message-id (mail-header-id header))
- (subject (gnus-summary-subject-string)))
- (org-store-mairix-link-props :from from
- :subject subject
- :message-id message-id))))
-
-(defun org-mairix-gnus-display-results (search args)
- "Display results of mairix search in Gnus.
-
-Note: This does not work as cleanly as I would like it to. The
-problem being that Gnus should simply reread the group cleanly,
-without remembering anything. At the moment it seems to be unable
-to do that -- so you're likely to see zombies floating around.
-
-If you can improve this, please do!"
- (if (not (equal (substring search 0 2) "m:" ))
- (error "org-mairix-gnus-display-results: display of search other than
-message-id not implemented yet"))
- (setq message-id (substring search 2 nil))
- (require 'gnus)
- (require 'gnus-sum)
- ;; FIXME: (bzg/gg) We might need to make sure gnus is running here,
- ;; and to start it in case it isn't running already. Does
- ;; anyone know a function to do that? It seems main org mode
- ;; does not do this, either.
- (funcall (cdr (assq 'gnus org-link-frame-setup)))
- (if gnus-other-frame-object (select-frame gnus-other-frame-object))
-
- ;; FIXME: This is horribly broken. Please see
- ;; http://article.gmane.org/gmane.emacs.gnus.general/65248
- ;; http://article.gmane.org/gmane.emacs.gnus.general/65265
- ;; http://article.gmane.org/gmane.emacs.gnus.user/9596
- ;; for reference.
- ;;
- ;; It seems gnus needs a "forget/ignore everything you think you
- ;; know about that group" function. Volunteers?
- ;;
- ;; For now different methods seem to work differently well for
- ;; different people. So we're playing hook-selection here to make
- ;; it easy to play around until we found a proper solution.
- (run-hook-with-args 'org-mairix-gnus-select-display-group-function)
- (gnus-summary-select-article
- nil t t (car (gnus-find-matching-articles "message-id" message-id))))
-
-(defun org-mairix-gnus-select-display-group-function-gg ()
- "Georg's hack to select a group that gnus (falsely) believes to be
-empty to then call rebuilding of the summary. It leaves zombies of
-old searches around, though."
- (gnus-group-quick-select-group 0 org-mairix-gnus-results-group)
- (gnus-group-clear-data)
- (gnus-summary-reselect-current-group t t))
-
-(defun org-mairix-gnus-select-display-group-function-bzg ()
- "This is the classic way the org mode is using, and it seems to be
-using better for Bastien, so it may work for you."
- (gnus-group-clear-data org-mairix-gnus-results-group)
- (gnus-group-read-group t nil org-mairix-gnus-results-group))
-
-(provide 'org-mairix)
-
-;;; org-mairix.el ends here
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-man.el b/.emacs.d/org-7.4/contrib/lisp/org-man.el
deleted file mode 100644
index 27e8cca..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-man.el
+++ /dev/null
@@ -1,64 +0,0 @@
-;;; org-man.el - Support for links to manpages in Org-mode
-;;
-;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: http://orgmode.org
-;; Version: 1.0
-;;
-;; This file is not yet 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, 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; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-
-(require 'org)
-
-(org-add-link-type "man" 'org-man-open)
-(add-hook 'org-store-link-functions 'org-man-store-link)
-
-(defcustom org-man-command 'man
- "The Emacs command to be used to display a man page."
- :group 'org-link
- :type '(choice (const man) (const woman)))
-
-(defun org-man-open (path)
- "Visit the manpage on PATH.
-PATH should be a topic that can be thrown at the man command."
- (funcall org-man-command path))
-
-(defun org-man-store-link ()
- "Store a link to a README file."
- (when (memq major-mode '(Man-mode woman-mode))
- ;; This is a man page, we do make this link
- (let* ((page (org-man-get-page-name))
- (link (concat "man:" page))
- (description (format "Manpage for %s" page)))
- (org-store-link-props
- :type "man"
- :link link
- :description description))))
-
-(defun org-man-get-page-name ()
- "Extract the page name from the buffer name."
- ;; This works for both `Man-mode' and `woman-mode'.
- (if (string-match " \\(\\S-+\\)\\*" (buffer-name))
- (match-string 1 (buffer-name))
- (error "Cannot create link to this man page")))
-
-(provide 'org-man)
-
-;;; org-man.el ends here
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-mime.el b/.emacs.d/org-7.4/contrib/lisp/org-mime.el
deleted file mode 100644
index bca6e91..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-mime.el
+++ /dev/null
@@ -1,245 +0,0 @@
-;;; org-mime.el --- org html export for text/html MIME emails
-
-;; Copyright (C) 2010 Eric Schulte
-
-;; Author: Eric Schulte
-;; Keywords: mime, mail, email, html
-;; Homepage: http://orgmode.org/worg/org-contrib/org-mime.php
-;; Version: 0.01
-
-;;; License:
-
-;; 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 3, 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 GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; WYSWYG, html mime composition using org-mode
-;;
-;; For mail composed using the orgstruct-mode minor mode, this
-;; provides a function for converting all or part of your mail buffer
-;; to embedded html as exported by org-mode. Call `org-mime-htmlize'
-;; in a message buffer to convert either the active region or the
-;; entire buffer to html.
-;;
-;; Similarly the `org-mime-org-buffer-htmlize' function can be called
-;; from within an org-mode buffer to convert the buffer to html, and
-;; package the results into an email handling with appropriate MIME
-;; encoding.
-;;
-;; you might want to bind this to a key with something like the
-;; following message-mode binding
-;;
-;; (add-hook 'message-mode-hook
-;; (lambda ()
-;; (local-set-key "\C-c\M-o" 'org-mime-htmlize)))
-;;
-;; and the following org-mode binding
-;;
-;; (add-hook 'org-mode-hook
-;; (lambda ()
-;; (local-set-key "\C-c\M-o" 'org-mime-org-buffer-htmlize)))
-
-;;; Code:
-(require 'cl)
-
-(defcustom org-mime-default-header
- "#+OPTIONS: latex:t\n"
- "Default header to control html export options, and ensure
- first line isn't assumed to be a title line."
- :group 'org-mime
- :type 'string)
-
-(defcustom org-mime-library 'mml
- "Library to use for marking up MIME elements."
- :group 'org-mime
- :type '(choice 'mml 'semi 'vm))
-
-(defcustom org-mime-preserve-breaks t
- "Used as temporary value of `org-export-preserve-breaks' during
- mime encoding."
- :group 'org-mime
- :type 'boolean)
-
-(defcustom org-mime-fixedwith-wrap
- "<pre style=\"font-family: courier, monospace;\">\n%s</pre>\n"
- "Format string used to wrap a fixedwidth HTML email."
- :group 'org-mime
- :type 'string)
-
-(defcustom org-mime-html-hook nil
- "Hook to run over the html buffer before attachment to email.
- This could be used for example to post-process html elements."
- :group 'org-mime
- :type 'hook)
-
-;; example hook, for setting a dark background in <pre style="background-color: #EEE;"> elements
-(defun org-mime-change-element-style (element style)
- "Set new default htlm style for <ELEMENT> elements in exported html."
- (while (re-search-forward (format "<%s" element) nil t)
- (replace-match (format "<%s style=\"%s\"" element style))))
-
-(defun org-mime-change-class-style (class style)
- "Set new default htlm style for objects with classs=CLASS in
-exported html."
- (while (re-search-forward (format "class=\"%s\"" class) nil t)
- (replace-match (format "class=\"%s\" style=\"%s\"" class style))))
-
-;; ;; example addition to `org-mime-html-hook' adding a dark background
-;; ;; color to <pre> elements
-;; (add-hook 'org-mime-html-hook
-;; (lambda ()
-;; (org-mime-change-element-style
-;; "pre" (format "color: %s; background-color: %s;"
-;; "#E6E1DC" "#232323"))
-;; (org-mime-change-class-style
-;; "verse" "border-left: 2px solid gray; padding-left: 4px;")))
-
-(defun org-mime-file (ext path id)
- "Markup a file for attachment."
- (case org-mime-library
- ('mml (format
- "<#part type=\"%s\" filename=\"%s\" id=\"<%s>\">\n<#/part>\n"
- ext path id))
- ('semi (concat
- (format
- "--[[%s\nContent-Disposition: inline;\nContent-ID: <%s>][base64]]\n"
- ext id)
- (base64-encode-string
- (with-temp-buffer
- (set-buffer-multibyte nil)
- (binary-insert-encoded-file path)
- (buffer-string)))))
- ('vm "?")))
-
-(defun org-mime-multipart (plain html)
- "Markup a multipart/alternative with text/plain and text/html
- alternatives."
- (case org-mime-library
- ('mml (format (concat "<#multipart type=alternative><#part type=text/plain>"
- "%s<#part type=text/html>%s<#/multipart>\n")
- plain html))
- ('semi (concat
- "--" "<<alternative>>-{\n"
- "--" "[[text/plain]]\n" plain
- "--" "[[text/html]]\n" html
- "--" "}-<<alternative>>\n"))
- ('vm "?")))
-
-(defun org-mime-replace-images (str current-file)
- "Replace images in html files with cid links."
- (let (html-images)
- (cons
- (replace-regexp-in-string ;; replace images in html
- "src=\"\\([^\"]+\\)\""
- (lambda (text)
- (format
- "src=\"cid:%s\""
- (let* ((url (and (string-match "src=\"\\([^\"]+\\)\"" text)
- (match-string 1 text)))
- (path (expand-file-name
- url (file-name-directory current-file)))
- (ext (file-name-extension path))
- (id (replace-regexp-in-string "[\/\\\\]" "_" path)))
- (add-to-list 'html-images
- (org-mime-file (concat "image/" ext) path id))
- id)))
- str)
- html-images)))
-
-(defun org-mime-htmlize (arg)
- "Export a portion of an email body composed using `mml-mode' to
-html using `org-mode'. If called with an active region only
-export that region, otherwise export the entire body."
- (interactive "P")
- (let* ((region-p (org-region-active-p))
- (html-start (or (and region-p (region-beginning))
- (save-excursion
- (goto-char (point-min))
- (search-forward mail-header-separator)
- (+ (point) 1))))
- (html-end (or (and region-p (region-end))
- ;; TODO: should catch signature...
- (point-max)))
- (raw-body (buffer-substring html-start html-end))
- (tmp-file (make-temp-name (expand-file-name "mail" temporary-file-directory)))
- (body (org-export-string raw-body "org" (file-name-directory tmp-file)))
- ;; because we probably don't want to skip part of our mail
- (org-export-skip-text-before-1st-heading nil)
- ;; because we probably don't want to export a huge style file
- (org-export-htmlize-output-type 'inline-css)
- ;; makes the replies with ">"s look nicer
- (org-export-preserve-breaks org-mime-preserve-breaks)
- ;; to hold attachments for inline html images
- (html-and-images
- (org-mime-replace-images
- (org-export-string raw-body "html" (file-name-directory tmp-file))
- tmp-file))
- (html-images (unless arg (cdr html-and-images)))
- (html (org-mime-apply-html-hook
- (if arg
- (format org-mime-fixedwith-wrap body)
- (car html-and-images)))))
- (delete-region html-start html-end)
- (save-excursion
- (goto-char html-start)
- (insert (org-mime-multipart body html)
- (mapconcat 'identity html-images "\n")))))
-
-(defun org-mime-apply-html-hook (html)
- (if org-mime-html-hook
- (with-temp-buffer
- (insert html)
- (goto-char (point-min))
- (run-hooks 'org-mime-html-hook)
- (buffer-string))
- html))
-
-(defun org-mime-org-buffer-htmlize ()
- "Export the current org-mode buffer to HTML using
-`org-export-as-html' and package the results into an email
-handling with appropriate MIME encoding."
- (interactive)
- (require 'reporter)
- (let* ((region-p (org-region-active-p))
- (current-file (buffer-file-name (current-buffer)))
- (html-start (or (and region-p (region-beginning))
- (save-excursion
- (goto-char (point-min)))))
- (html-end (or (and region-p (region-end))
- (point-max)))
- (temp-body-file (make-temp-file "org-mime-export"))
- (raw-body (buffer-substring html-start html-end))
- (body (with-temp-buffer
- (insert raw-body)
- (write-file temp-body-file)
- (org-export-as-org nil nil nil 'string t)))
- (org-link-file-path-type 'absolute)
- ;; because we probably don't want to export a huge style file
- (org-export-htmlize-output-type 'inline-css)
- ;; to hold attachments for inline html images
- (html-and-images (org-mime-replace-images
- (org-export-as-html nil nil nil 'string t)
- current-file))
- (html-images (cdr html-and-images))
- (html (org-mime-apply-html-hook (car html-and-images))))
- ;; dump the exported html into a fresh message buffer
- (reporter-compose-outgoing)
- (goto-char (point-max))
- (prog1 (insert (org-mime-multipart body html)
- (mapconcat 'identity html-images "\n"))
- (delete-file temp-body-file))))
-
-(provide 'org-mime) \ No newline at end of file
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-mtags.el b/.emacs.d/org-7.4/contrib/lisp/org-mtags.el
deleted file mode 100644
index 2406552..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-mtags.el
+++ /dev/null
@@ -1,257 +0,0 @@
-;;; org-mtags.el --- Muse-like tags in Org-mode
-;; Copyright (C) 2008, 2009 Free Software Foundation, Inc.
-;;
-;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: http://orgmode.org
-;; Version: 0.01
-;;
-;; This file is not yet 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, 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; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-;;
-;; This modules implements some of the formatting tags available in
-;; Emacs Muse. This is not a way if adding new functionality, but just
-;; a different way to write some formatting directives. The advantage is
-;; that files written in this way can be read by Muse reasonably well,
-;; and that this provides an alternative way of writing formatting
-;; directives in Org, a way that some might find more pleasant to type
-;; and look at that the Org's #+BEGIN..#+END notation.
-
-;; The goal of this development is to make it easier for people to
-;; move between both worlds as they see fit for different tasks.
-
-;; The following muse tags will be translated during export into their
-;; native Org equivalents:
-;;
-;; <br>
-;; Needs to be at the end of a line. Will be translated to "\\".
-;;
-;; <example switches="-n -r">
-;; Needs to be on a line by itself, similarly the </example> tag.
-;; Will be translated into Org's #+BEGIN_EXAMPLE construct.
-;;
-;; <quote>
-;; Needs to be on a line by itself, similarly the </quote> tag.
-;; Will be translated into Org's #+BEGIN_QUOTE construct.
-;;
-;; <comment>
-;; Needs to be on a line by itself, similarly the </comment> tag.
-;; Will be translated into Org's #+BEGIN_COMMENT construct.
-;;
-;; <verse>
-;; Needs to be on a line by itself, similarly the </verse> tag.
-;; Will be translated into Org's #+BEGIN_VERSE construct.
-;;
-;; <contents>
-;; This gets translated into "[TABLE-OF-CONTENTS]". It will not
-;; trigger the production of a table of contents - that is done
-;; in Org with the "#+OPTIONS: toc:t" setting. But it will define
-;; the location where the TOC will be placed.
-;;
-;; <literal style="STYLE"> ;; only latex, html, and docbook supported
-;; in Org.
-;; Needs to be on a line by itself, similarly the </literal> tag.
-;;
-;; <src lang="LANG" switches="-n -r">
-;; Needs to be on a line by itself, similarly the </src> tag.
-;; Will be translated into Org's BEGIN_SRC construct.
-;;
-;; <include file="FILE" markup="MARKUP" lang="LANG"
-;; prefix="str" prefix1="str" switches="-n -r">
-;; Needs to be on a line by itself.
-;; Will be translated into Org's #+INCLUDE construct.
-;;
-;; The lisp/perl/ruby/python tags can be implemented using the
-;; `org-eval.el' module, which see.
-
-(require 'org)
-
-;;; Customization
-
-(defgroup org-mtags nil
- "Options concerning Muse tags in Org mode."
- :tag "Org Muse Tags"
- :group 'org)
-
-(defface org-mtags ; similar to shadow
- (org-compatible-face 'shadow
- '((((class color grayscale) (min-colors 88) (background light))
- (:foreground "grey50"))
- (((class color grayscale) (min-colors 88) (background dark))
- (:foreground "grey70"))
- (((class color) (min-colors 8) (background light))
- (:foreground "green"))
- (((class color) (min-colors 8) (background dark))
- (:foreground "yellow"))))
- "Face for Muse-like tags in Org."
- :group 'org-mtags
- :group 'org-faces)
-
-(defcustom org-mtags-prefer-muse-templates t
- "Non-nil means prefere Muse tags for structure elements.
-This is relevane when expanding the templates defined in the variable
-`org-structure-templates'."
- :group 'org-mtags
- :type 'boolean)
-
-(defconst org-mtags-supported-tags
- '("example" "quote" "comment" "verse" "contents" "literal" "src" "include")
- "The tags that are supported by org-mtags.el for conversion.
-In addition to this list, the <br> tag is supported as well.")
-
-(defconst org-mtags-fontification-re
- (concat
- "^[ \t]*</?\\("
- (mapconcat 'identity org-mtags-supported-tags "\\|")
- "\\)\\>[^>]*>\\|<br>[ \t]*$")
- "Regular expression used for fontifying muse tags.")
-
-(defun org-mtags-replace ()
- "Replace Muse-like tags with the appropriate Org constructs.
-The is done in the entire buffer."
- (interactive) ;; FIXME
- (let ((re (concat "^[ \t]*\\(</?\\("
- (mapconcat 'identity org-mtags-supported-tags "\\|")
- "\\)\\>\\)"))
- info tag rpl style markup lang file prefix prefix1 switches)
- ;; First, do the <br> tag
- (goto-char (point-min))
- (while (re-search-forward "<br>[ \t]*$" nil t)
- (replace-match "\\\\" t t))
- ;; Now, all the other tags
- (goto-char (point-min))
- (while (re-search-forward re nil t)
- (goto-char (match-beginning 1))
- (setq info (org-mtags-get-tag-and-attributes))
- (if (not info)
- (end-of-line 1)
- (setq tag (plist-get info :tag))
- (cond
- ((equal tag "contents")
- (setq rpl "[TABLE-OF-CONTENTS]")
- ;; FIXME: also trigger TOC in options-plist?????
- )
- ((member tag '("quote" "comment" "verse"))
- (if (plist-get info :closing)
- (setq rpl (format "#+END_%s" (upcase tag)))
- (setq rpl (format "#+BEGIN_%s" (upcase tag)))))
- ((equal tag "literal")
- (setq style (plist-get info :style))
- (and style (setq style (downcase style)))
- (if (plist-get info :closing)
- (setq rpl (cond
- ((member style '("latex"))
- "#+END_LaTeX")
- ((member style '("html"))
- "#+END_HTML")
- ((member style '("docbook"))
- "#+END_DOCBOOK")
- ((member style '("ascii"))
- "#+END_ASCII")))
- (setq rpl (cond
- ((member style '("latex"))
- "#+BEGIN_LaTeX")
- ((member style '("html"))
- "#+BEGIN_HTML")
- ((member style '("ascii"))
- "#+BEGIN_ASCII")))))
- ((equal tag "example")
- (if (plist-get info :closing)
- (setq rpl "#+END_EXAMPLE")
- (setq rpl "#+BEGIN_EXAMPLE")
- (when (setq switches (plist-get info :switches))
- (setq rpl (concat rpl " " switches)))))
- ((equal tag "src")
- (if (plist-get info :closing)
- (setq rpl "#+END_SRC")
- (setq rpl "#+BEGIN_SRC")
- (when (setq lang (plist-get info :lang))
- (setq rpl (concat rpl " " lang))
- (when (setq switches (plist-get info :switches))
- (setq rpl (concat rpl " " switches))))))
- ((equal tag "include")
- (setq file (plist-get info :file)
- markup (downcase (plist-get info :markup))
- lang (plist-get info :lang)
- prefix (plist-get info :prefix)
- prefix1 (plist-get info :prefix1)
- switches (plist-get info :switches))
- (setq rpl "#+INCLUDE")
- (setq rpl (concat rpl " " (prin1-to-string file)))
- (when markup
- (setq rpl (concat rpl " " markup))
- (when (and (equal markup "src") lang)
- (setq rpl (concat rpl " " lang))))
- (when prefix
- (setq rpl (concat rpl " :prefix " (prin1-to-string prefix))))
- (when prefix1
- (setq rpl (concat rpl " :prefix1 " (prin1-to-string prefix1))))
- (when switches
- (setq rpl (concat rpl " " switches)))))
- (when rpl
- (goto-char (plist-get info :match-beginning))
- (delete-region (point-at-bol) (plist-get info :match-end))
- (insert rpl))))))
-
-(defun org-mtags-get-tag-and-attributes ()
- "Parse a Muse-like tag at point ant rturn the information about it.
-The return value is a property list which contains all the attributes
-with string values. In addition, it reutnrs the following properties:
-
-:tag The tag as a string.
-:match-beginning The beginning of the match, just before \"<\".
-:match-end The end of the match, just after \">\".
-:closing t when the tag starts with \"</\"."
- (when (looking-at "<\\(/\\)?\\([a-zA-Z]+\\>\\)\\([^>]*\\)>")
- (let ((start 0)
- tag rest prop attributes endp val)
- (setq tag (org-match-string-no-properties 2)
- endp (match-end 1)
- rest (and (match-end 3)
- (org-match-string-no-properties 3))
- attributes (list :tag tag
- :match-beginning (match-beginning 0)
- :match-end (match-end 0)
- :closing endp))
- (when rest
- (while (string-match "\\([a-zA-Z]+\\)=\\([^ \t\n>]+\\|\"[^>]+\"\\)"
- rest start)
- (setq start (match-end 0)
- prop (org-match-string-no-properties 1 rest)
- val (org-remove-double-quotes
- (org-match-string-no-properties 2 rest)))
- (setq attributes (plist-put attributes
- (intern (concat ":" prop)) val))))
- attributes)))
-
-(defun org-mtags-fontify-tags (limit)
- "Fontify the muse-like tags."
- (while (re-search-forward org-mtags-fontification-re limit t)
- (add-text-properties (match-beginning 0) (match-end 0)
- '(face org-mtags font-lock-multiline t
- font-lock-fontified t))))
-
-(add-hook 'org-export-preprocess-hook 'org-mtags-replace)
-(add-hook 'org-font-lock-hook 'org-mtags-fontify-tags)
-
-(provide 'org-mtags)
-
-;;; org-mtags.el ends here
-
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-panel.el b/.emacs.d/org-7.4/contrib/lisp/org-panel.el
deleted file mode 100644
index fe0ec64..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-panel.el
+++ /dev/null
@@ -1,642 +0,0 @@
-;;; org-panel.el --- Simple routines for us with bad memory
-;;
-;; Author: Lennart Borgman (lennart O borgman A gmail O com)
-;; Created: Thu Nov 15 15:35:03 2007
-;; Version: 0.21
-;; Lxast-Updated: Wed Nov 21 03:06:03 2007 (3600 +0100)
-;; URL:
-;; Keywords:
-;; Compatibility:
-;;
-;; Features that might be required by this library:
-;;
-;; `easymenu', `font-lock', `noutline', `org', `outline', `syntax',
-;; `time-date'.
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-;;
-;; This defines a kind of control panel for `org-mode'. This control
-;; panel should make it fast to move around and edit structure etc.
-;;
-;; To bring up the control panel type
-;;
-;; M-x orgpan-panel
-;;
-;; Type ? there for help.
-;;
-;; I suggest you add the following to your .emacs for quick access of
-;; the panel:
-;;
-;; (eval-after-load 'org-mode
-;; (define-key org-mode-map [(control ?c) ?p] 'orgpan-panel))
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Change log:
-;;
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; 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; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-;; Floor, Boston, MA 02110-1301, USA.
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Code:
-
-(require 'org)
-(require 'outline)
-
-;; Fix-me: this is for testing. A minor mode version interferes badly
-;; with emulation minor modes. On the other hand, the other version
-;; interferes badly with (interactive ...).
-(defvar orgpan-minor-mode-version t)
-
-(defface orgpan-field
- '((t (:inherit 'widget-field)))
- "Face for fields."
- :group 'winsize)
-(defvar orgpan-field-face 'orgpan-field)
-
-(defface orgpan-active-field
- '((t (:inherit 'highlight)))
- "Face for fields."
- :group 'winsize)
-(defvar orgpan-active-field-face 'orgpan-active-field)
-
-(defface orgpan-spaceline
- '((t (:height 0.2)))
- "Face for spacing lines."
- :group 'winsize)
-
-(defcustom orgpan-panel-buttons nil
- "Panel style, if non-nil use buttons.
-If there are buttons in the panel they are used to change the way
-the arrow keys work. The panel looks something like this, with
-the first button chosen:
-
- [Navigate] [Restructure] [TODO/Priority]
- ----------
- up/down, left: Go to, right: Visibility
-
-The line below the buttons try to give a short hint about what
-the arrow keys does. \(Personally I prefer the version without
-buttons since I then do not have to remember which button is
-active.)"
- :type 'boolean
- :group 'winsize)
-
-;; Fix-me: add org-mode-map
-(defconst orgpan-org-mode-commands nil)
-(defconst orgpan-org-commands
- '(
- orgpan-copy-subtree
- orgpan-cut-subtree
- orgpan-paste-subtree
- undo
- ;;
- ;orgpan-occur
- ;;
- org-cycle
- org-global-cycle
- outline-up-heading
- outline-next-visible-heading
- outline-previous-visible-heading
- outline-forward-same-level
- outline-backward-same-level
- org-todo
- org-show-todo-tree
- org-priority-up
- org-priority-down
- org-move-subtree-up
- org-move-subtree-down
- org-do-promote
- org-do-demote
- org-promote-subtree
- org-demote-subtree))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Hook functions etc
-
-;;(defvar orgpan-this-panel-window nil)
-
-(defun orgpan-delete-panel ()
- "Remove the panel."
- (interactive)
- (when (buffer-live-p orgpan-panel-buffer)
- (delete-windows-on orgpan-panel-buffer)
- (kill-buffer orgpan-panel-buffer))
- (setq orgpan-panel-buffer nil)
- (setq orgpan-panel-window nil)
- (orgpan-panel-minor-mode 0)
- (remove-hook 'post-command-hook 'orgpan-minor-post-command)
- (remove-hook 'post-command-hook 'orgpan-mode-post-command)
- ;;(remove-hook 'window-configuration-change-hook 'orgpan-window-config-change)
- )
-
-(defvar orgpan-last-command-was-from-panel nil)
-(defun orgpan-mode-pre-command ()
- (setq orgpan-last-command-was-from-panel nil)
- (condition-case err
- (if (not (and (windowp orgpan-org-window)
- (window-live-p orgpan-org-window)))
- (progn
- (setq this-command 'ignore)
- (orgpan-delete-panel)
- (message "The window belonging to the panel had disappeared, removed panel."))
- (let ((buf (window-buffer orgpan-org-window)))
- (when (with-current-buffer buf
- (derived-mode-p 'org-mode))
- (setq orgpan-last-org-buffer buf))
- ;; Fix me: add a list of those commands that are not
- ;; meaningful from the panel (for example org-time-stamp)
- (when (or (memq this-command orgpan-org-commands)
- (memq this-command orgpan-org-mode-commands)
- ;; For some reason not all org commands are found above:
- (string= "org-" (substring (format "%s" this-command) 0 4)))
- (if (not (with-current-buffer buf
- (derived-mode-p 'org-mode)))
- (progn
- (if (buffer-live-p orgpan-org-buffer)
- (set-window-buffer orgpan-org-window orgpan-org-buffer)
- (message "Please use `l' or `b' to choose an org-mode buffer"))
- (setq this-command 'ignore))
- (setq orgpan-org-buffer (window-buffer orgpan-org-window))
- (setq orgpan-last-command-was-from-panel t)
- (select-window orgpan-org-window)
- ;;(when (active-minibuffer-window
- ;;(set-buffer orgpan-org-buffer)
- ))))
- (error (lwarn 't :warning "orgpan-pre: %S" err))))
-
-(defun orgpan-mode-post-command ()
- (condition-case err
- (progn
- (unless (and (windowp orgpan-panel-window)
- (window-live-p orgpan-panel-window)
- (bufferp orgpan-panel-buffer)
- (buffer-live-p orgpan-panel-buffer))
- ;;(orgpan-delete-panel)
- )
- (when (and orgpan-last-command-was-from-panel
- (windowp orgpan-panel-window)
- (window-live-p orgpan-panel-window))
- (select-window orgpan-panel-window)
- (when (derived-mode-p 'orgpan-mode)
- (setq deactivate-mark t)
- (when orgpan-panel-buttons
- (unless (and orgpan-point
- (= (point) orgpan-point))
- ;; Go backward so it is possible to click on a "button":
- (orgpan-backward-field)))))
- (setq orgpan-this-panel-window nil))
- (error (lwarn 't :warning "orgpan-post: %S" err))))
-
-;; (defun orgpan-window-config-change ()
-;; "Check if any frame is displaying an orgpan panel.
-;; If not remove `orgpan-mode-post-command' and this function from
-;; the hooks."
-;; (condition-case err
-;; (unless (and (
-;; (let ((found-pan nil))
-;; (dolist (f (frame-list))
-;; (dolist (w (window-list f 'nomini))
-;; (with-current-buffer (window-buffer w)
-;; (when (derived-mode-p 'orgpan-mode)
-;; (setq found-pan t)))))
-;; (unless found-pan
-;; (remove-hook 'post-command-hook 'orgpan-mode-post-command)
-;; (remove-hook 'window-configuration-change-hook 'orgpan-window-config-change)))
-;; (error (lwarn 't :warning "Error in orgpan-config-change: %S" err))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Commands
-
-(defun orgpan-last-buffer ()
- "Open last org-mode buffer in panels org window."
- (interactive)
- (let ((buf (window-buffer orgpan-org-window))
- (last-buf orgpan-last-org-buffer))
- (when (with-current-buffer buf
- (derived-mode-p 'org-mode))
- (setq orgpan-last-org-buffer buf))
- (when (eq last-buf buf)
- (setq last-buf nil))
- (if (not last-buf)
- (orgpan-switch-buffer)
- (set-window-buffer orgpan-org-window last-buf))))
-
-(defun orgpan-switch-buffer ()
- "Switch to next org-mode buffer in panels org window."
- (interactive)
- (let ((buf (window-buffer orgpan-org-window))
- (org-buffers nil))
- (with-current-buffer buf
- (when (derived-mode-p 'org-mode)
- (bury-buffer buf)
- (setq orgpan-last-org-buffer buf)))
- (setq org-buffers (delq nil (mapcar (lambda (buf)
- (when (with-current-buffer buf
- (derived-mode-p 'org-mode))
- buf))
- (buffer-list))))
- (setq org-buffers (delq buf org-buffers))
- (set-window-buffer orgpan-org-window (car org-buffers))
- (setq orgpan-org-buffer (car org-buffers))))
-
-(defun orgpan-paste-subtree ()
- (interactive)
- (if (y-or-n-p "Paste subtree here? ")
- (org-paste-subtree)
- (message "Nothing was pasted")))
-
-(defun orgpan-cut-subtree ()
- (interactive)
- (let ((heading (progn
- (org-back-to-heading)
- (buffer-substring (point) (line-end-position))
- )))
- (if (y-or-n-p (format "Do you want to cut the subtree\n%s\n? " heading))
- (org-cut-subtree)
- (message "Nothing was cut"))))
-
-(defun orgpan-copy-subtree ()
- (interactive)
- (let ((heading (progn
- (org-back-to-heading)
- (buffer-substring (point) (line-end-position))
- )))
- (if (y-or-n-p (format "Do you want to copy the subtree\n%s\n? " heading))
- (org-copy-subtree)
- (message "Nothing was copied"))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Buttons
-
-(defvar orgpan-ovl-help nil)
-
-(defun orgpan-check-panel-mode ()
- (unless (derived-mode-p 'orgpan-mode)
- (error "Not orgpan-mode in buffer: " major-mode)))
-
-(defun orgpan-display-bindings-help ()
- (orgpan-check-panel-mode)
- (setq orgpan-point (point))
- (let* ((ovls (overlays-at (point)))
- (ovl (car ovls))
- (help (when ovl (overlay-get ovl 'orgpan-explain))))
- (dolist (o (overlays-in (point-min) (point-max)))
- (overlay-put o 'face orgpan-field-face))
- (overlay-put ovl 'face orgpan-active-field-face)
- (overlay-put orgpan-ovl-help 'before-string help)))
-
-(defun orgpan-forward-field ()
- (interactive)
- (orgpan-check-panel-mode)
- (let ((pos (next-overlay-change (point))))
- (unless (overlays-at pos)
- (setq pos (next-overlay-change pos)))
- (when (= pos (point-max))
- (setq pos (point-min))
- (unless (overlays-at pos)
- (setq pos (next-overlay-change pos))))
- (goto-char pos))
- (orgpan-display-bindings-help))
-
-(defun orgpan-backward-field ()
- (interactive)
- (orgpan-check-panel-mode)
- (when (= (point) (point-min))
- (goto-char (point-max)))
- (let ((pos (previous-overlay-change (point))))
- (unless (overlays-at pos)
- (setq pos (previous-overlay-change pos)))
- (goto-char pos))
- (orgpan-display-bindings-help))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Mode
-
-(defconst orgpan-mode-map
- ;; Fix-me: clean up here!
- ;; Fix-me: viper support
- (let ((map (make-sparse-keymap)))
- (define-key map [?q] 'orgpan-delete-panel)
- (define-key map [??] 'orgpan-help)
- ;; Copying etc
- (define-key map [?c] 'orgpan-copy-subtree)
- (define-key map [?x] 'orgpan-cut-subtree)
- (define-key map [?p] 'orgpan-paste-subtree)
- (define-key map [?z] 'undo)
- ;; Buffers:
- (define-key map [?b] 'orgpan-switch-buffer)
- (define-key map [?l] 'orgpan-last-buffer)
- ;; Some keys for moving between headings. Emacs keys for next/prev
- ;; line seems ok:
- (define-key map [(control ?p)] 'outline-previous-visible-heading)
- (define-key map [(control ?n)] 'outline-next-visible-heading)
- (define-key map [(shift control ?p)] 'outline-backward-same-level)
- (define-key map [(shift control ?n)] 'outline-forward-same-level)
- ;; A mnemunic for up:
- (define-key map [(control ?u)] 'outline-up-heading)
- ;; Search sparse tree:
- ;;
- ;; Fix-me: Search does not work, some problem with
- ;; interactive. Probably have to turn the whole thing around and
- ;; always be in the org buffer, but with a minor mode running
- ;; there.
- ;;
- ;;(define-key map [?s] 'org-sparse-tree)
- (define-key map [?s] 'orgpan-occur)
- ;; Same as in org-mode:
- ;;(define-key map [(control ?c)(control ?v)] 'org-show-todo-tree)
- ;; Fix-me: This leads to strange problems:
- ;;(define-key map [t] 'ignore)
- map))
-
-(defun orgpan-occur ()
- "Replacement for `org-occur'.
-Technical reasons."
- (interactive)
- (let ((rgx (read-from-minibuffer "my mini Regexp: ")))
- (setq orgpan-last-command-was-from-panel t)
- (select-window orgpan-org-window)
- (org-occur rgx)))
-
-(defvar orgpan-panel-window nil
- "The window showing `orgpan-panel-buffer'.")
-
-(defvar orgpan-panel-buffer nil
- "The panel buffer.
-There can be only one such buffer at any time.")
-
-(defvar orgpan-org-window nil)
-;;(make-variable-buffer-local 'orgpan-org-window)
-
-;; Fix-me: used?
-(defvar orgpan-org-buffer nil)
-;;(make-variable-buffer-local 'orgpan-org-buffer)
-
-(defvar orgpan-last-org-buffer nil)
-;;(make-variable-buffer-local 'orgpan-last-org-buffer)
-
-(defvar orgpan-point nil)
-;;(make-variable-buffer-local 'orgpan-point)
-
-(defun orgpan-avoid-viper-in-buffer ()
- ;; Fix-me: This is ugly. However see `this-major-mode-requires-vi-state':
- (set (make-local-variable 'viper-emacs-state-mode-list) '(orgpan-mode))
- (set (make-local-variable 'viper-new-major-mode-buffer-list) nil)
- (local-set-key [?\ ] 'ignore))
-
-(define-derived-mode orgpan-mode nil "Org-Panel"
- "Mode for org-simple.el control panel."
- (setq buffer-read-only t)
- (unless orgpan-minor-mode-version
- (add-hook 'pre-command-hook 'orgpan-mode-pre-command nil t)
- (add-hook 'post-command-hook 'orgpan-mode-post-command t))
- (orgpan-avoid-viper-in-buffer)
- (setq cursor-type nil))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Panel layout
-
-(defun orgpan-insert-field (text keymap explain)
- (insert text)
- (let* ((end (point))
- (len (length text))
- (beg (- end len))
- (ovl (make-overlay beg end)))
- (overlay-put ovl 'face orgpan-field-face)
- (overlay-put ovl 'keymap keymap)
- (overlay-put ovl 'orgpan-explain explain)))
-
-(defconst orgpan-with-keymap
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map org-mode-map)
- ;; Users are used to tabbing between fields:
- (define-key map [(tab)] 'orgpan-forward-field)
- (define-key map [(shift tab)] 'orgpan-backward-field)
- ;; Now we must use something else for visibility (first does not work if Viper):
- (define-key map [(meta tab)] 'org-cycle)
- (define-key map [(control meta tab)] 'org-global-cycle)
- map))
-
-(defconst orgpan-without-keymap
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map org-mode-map)
- ;; Visibility (those are in org-mode-map):
- ;;(define-key map [tab] 'org-cycle)
- ;;(define-key map [(shift tab)] 'org-global-cycle)
- ;; Navigate:
- (define-key map [left] 'outline-up-heading)
- (define-key map [right] 'org-cycle)
- (define-key map [up] 'outline-previous-visible-heading)
- (define-key map [down] 'outline-next-visible-heading)
- (define-key map [(shift down)] 'outline-forward-same-level)
- (define-key map [(shift up)] 'outline-backward-same-level)
- ;; Restructure:
- (define-key map [(control up)] 'org-move-subtree-up)
- (define-key map [(control down)] 'org-move-subtree-down)
- (define-key map [(control left)] 'org-do-promote)
- (define-key map [(control right)] 'org-do-demote)
- (define-key map [(control shift left)] 'org-promote-subtree)
- (define-key map [(control shift right)] 'org-demote-subtree)
- ;; Todo etc
- (define-key map [?+] 'org-priority-up)
- (define-key map [?-] 'org-priority-down)
- (define-key map [?t] 'org-todo)
- map))
-
-(defun orgpan-make-panel-without-buttons (buf)
- (with-current-buffer buf
- (insert (propertize "Org Panel" 'face 'orgpan-active-field))
- (insert " ? for help, q quit\n")
- (insert (propertize "arrows" 'face 'font-lock-keyword-face)
- ": Go to, "
- (propertize "C-arrows" 'face 'font-lock-keyword-face)
- ": Edit tree\n"
- (propertize "cxpz" 'face 'font-lock-keyword-face)
- ": copy cut paste undo, "
- (propertize "tT+-" 'face 'font-lock-keyword-face)
- ": todo priority, "
- (propertize "s" 'face 'font-lock-keyword-face)
- " search"
- )
- (set-keymap-parent orgpan-mode-map orgpan-without-keymap)
- ))
-
-(defun orgpan-make-panel-with-buttons (buf)
- (with-current-buffer buf
- (let* ((base-map (make-sparse-keymap))
- (space-line (propertize "\n\n" 'face 'orgpan-spaceline))
- (arrow-face 'font-lock-keyword-face)
- (L (propertize "left" 'face arrow-face))
- (R (propertize "right" 'face arrow-face))
- (U (propertize "up" 'face arrow-face))
- (D (propertize "down" 'face arrow-face)))
- ;;(message D)(sit-for 2)
- (define-key base-map [left] 'ignore)
- (define-key base-map [right] 'ignore)
- (define-key base-map [up] 'ignore)
- (define-key base-map [down] 'ignore)
- (define-key base-map [?q] 'delete-window)
- (define-key base-map [??] 'orgpan-help)
- ;; Navigating
- (let ((map (copy-keymap base-map)))
- (define-key map [left] 'outline-up-heading)
- (define-key map [right] 'org-cycle)
- (define-key map [up] 'outline-previous-visible-heading)
- (define-key map [down] 'outline-next-visible-heading)
- (define-key map [(shift down)] 'outline-forward-same-level)
- (define-key map [(shift up)] 'outline-backward-same-level)
- (orgpan-insert-field "Navigate" map (concat U "/" D ", " L ": Go to, " R ": Visibility")))
- (insert " ")
- (let ((map (copy-keymap base-map)))
- (define-key map [up] 'org-move-subtree-up)
- (define-key map [down] 'org-move-subtree-down)
- (define-key map [left] 'org-do-promote)
- (define-key map [right] 'org-do-demote)
- (define-key map [(shift left)] 'org-promote-subtree)
- (define-key map [(shift right)] 'org-demote-subtree)
- (orgpan-insert-field
- "Restructure" map
- (concat U "/" D ": "
- (propertize "Move" 'face 'font-lock-warning-face)
- ", " L "/" R ": "
- (propertize "Level (w S: Subtree Level)" 'face 'font-lock-warning-face))))
- (insert " ")
- (let ((map (copy-keymap base-map)))
- (define-key map [up] 'org-priority-up)
- (define-key map [down] 'org-priority-down)
- (define-key map [right] 'org-todo)
- (orgpan-insert-field "TODO/priority" map
- (concat R ": TODO, " U "/" D ": Priority")))
- )
- (insert " ? for help, q quit\n")
- (orgpan-display-bindings-help)
- (setq orgpan-ovl-help (make-overlay (point) (point)))
- ))
-
-(defun orgpan-make-panel-buffer ()
- "Make the panel buffer."
- (let* ((buf-name "*Org Panel*"))
- (when orgpan-panel-buffer (kill-buffer orgpan-panel-buffer))
- (setq orgpan-panel-buffer (get-buffer-create buf-name))
- (if orgpan-panel-buttons
- (orgpan-make-panel-with-buttons orgpan-panel-buffer)
- (orgpan-make-panel-without-buttons orgpan-panel-buffer))
- (with-current-buffer orgpan-panel-buffer
- (orgpan-mode)
- (goto-char (point-min)))
- orgpan-panel-buffer))
-
-(defun orgpan-help ()
- (interactive)
- (set-keymap-parent orgpan-with-keymap nil)
- (set-keymap-parent orgpan-without-keymap nil)
- (describe-function 'orgpan-panel)
- (set-keymap-parent orgpan-with-keymap org-mode-map)
- (set-keymap-parent orgpan-without-keymap org-mode-map)
- (message "Use 'l' to remove help window")
- )
-
-(defun orgpan-panel ()
- "Create a control panel for current `org-mode' buffer.
-The control panel may be used to quickly move around and change
-the headings. The idea is that when you want to to a lot of this
-kind of editing you should be able to do that with few
-keystrokes (and without having to remember the complicated
-keystrokes). A typical situation when this perhaps can be useful
-is when you are looking at your notes file \(usually ~/.notes,
-see `remember-data-file') where you have saved quick notes with
-`remember'.
-
-The keys below are defined in the panel. Note that the commands
-are carried out in the `org-mode' buffer that belongs to the
-panel.
-
-\\{orgpan-mode-map}
-
-In addition to the keys above most of the keys in `org-mode' can
-also be used from the panel.
-
-Note: There are two forms of the control panel, one with buttons
-and one without. The default is without, see
-`orgpan-panel-buttons'. If buttons are used choosing a different
-button changes the binding of the arrow keys."
- (interactive)
- (unless (derived-mode-p 'org-mode)
- (error "Buffer is not in org-mode"))
- (orgpan-delete-panel)
- (unless orgpan-org-mode-commands
- (map-keymap (lambda (ev def)
- (when (and def
- (symbolp def)
- (fboundp def))
- (setq orgpan-org-mode-commands
- (cons def orgpan-org-mode-commands))))
- org-mode-map))
- ;;(org-back-to-heading)
- ;;(remove-hook 'window-configuration-change-hook 'orgpan-window-config-change)
- (split-window)
- (set-window-buffer (selected-window) (orgpan-make-panel-buffer))
- (setq orgpan-panel-window (selected-window))
- ;;(set-window-dedicated-p (selected-window) t)
- (fit-window-to-buffer nil nil 3)
- (setq orgpan-org-window (next-window))
- ;; The minor mode version starts here:
- (when orgpan-minor-mode-version
- (select-window orgpan-org-window)
- (orgpan-panel-minor-mode 1)
- (add-hook 'post-command-hook 'orgpan-minor-post-command t)))
-
-(defun orgpan-minor-post-command ()
- (unless (and
- ;; Check org window and buffer
- (windowp orgpan-org-window)
- (window-live-p orgpan-org-window)
- (eq orgpan-org-window (selected-window))
- (derived-mode-p 'org-mode)
- ;; Check panel window and buffer
- (windowp orgpan-panel-window)
- (window-live-p orgpan-panel-window)
- (bufferp orgpan-panel-buffer)
- (buffer-live-p orgpan-panel-buffer)
- (eq (window-buffer orgpan-panel-window) orgpan-panel-buffer)
- ;; Check minor mode
- orgpan-panel-minor-mode)
- (orgpan-delete-panel)))
-
-(define-minor-mode orgpan-panel-minor-mode
- "Minor mode used in `org-mode' buffer when showing panel."
- :keymap orgpan-mode-map
- :lighter " PANEL"
- :group 'orgpan
- )
-
-
-(provide 'org-panel)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; org-panel.el ends here
-
-
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-registry.el b/.emacs.d/org-7.4/contrib/lisp/org-registry.el
deleted file mode 100644
index ad382f0..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-registry.el
+++ /dev/null
@@ -1,271 +0,0 @@
-;;; org-registry.el --- a registry for Org links
-;;
-;; Copyright 2007, 2008 Bastien Guerry
-;;
-;; Emacs Lisp Archive Entry
-;; Filename: org-registry.el
-;; Version: 0.1a
-;; Author: Bastien Guerry <bzg AT altern DOT org>
-;; Maintainer: Bastien Guerry <bzg AT altern DOT org>
-;; Keywords: org, wp, registry
-;; Description: Shows Org files where the current buffer is linked
-;; URL: http://www.cognition.ens.fr/~guerry/u/org-registry.el
-;;
-;; 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 3, 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, write to the Free Software
-;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Commentary:
-;;
-;; This library add a registry to your Org setup.
-;;
-;; Org files are full of links inserted with `org-store-link'. This links
-;; point to e-mail, webpages, files, dirs, info pages, man pages, etc.
-;; Actually, they come from potentially *everywhere* since Org lets you
-;; define your own storing/following functions.
-;;
-;; So, what if you are on a e-mail, webpage or whatever and want to know if
-;; this buffer has already been linked to somewhere in your agenda files?
-;;
-;; This is were org-registry comes in handy.
-;;
-;; M-x org-registry-show will tell you the name of the file
-;; C-u M-x org-registry-show will directly jump to the file
-;;
-;; In case there are several files where the link lives in:
-;;
-;; M-x org-registry-show will display them in a new window
-;; C-u M-x org-registry-show will prompt for a file to visit
-;;
-;; Add this to your Org configuration:
-;;
-;; (require 'org-registry)
-;; (org-registry-initialize)
-;;
-;; If you want to update the registry with newly inserted links in the
-;; current buffer: M-x org-registry-update
-;;
-;; If you want this job to be done each time you save an Org buffer,
-;; hook 'org-registry-update to the local 'after-save-hook in org-mode:
-;;
-;; (org-registry-insinuate)
-
-;;; Code:
-
-(eval-when-compile
- (require 'cl))
-
-(defgroup org-registry nil
- "A registry for Org."
- :group 'org)
-
-(defcustom org-registry-file
- (concat (getenv "HOME") "/.org-registry.el")
- "The Org registry file."
- :group 'org-registry
- :type 'file)
-
-(defcustom org-registry-find-file 'find-file-other-window
- "How to find visit files."
- :type 'function
- :group 'org-registry)
-
-(defvar org-registry-alist nil
- "An alist containing the Org registry.")
-
-;;;###autoload
-(defun org-registry-show (&optional visit)
- "Show Org files where there are links pointing to the current
-buffer."
- (interactive "P")
- (org-registry-initialize)
- (let* ((blink (or (org-remember-annotation) ""))
- (link (when (string-match org-bracket-link-regexp blink)
- (match-string-no-properties 1 blink)))
- (desc (or (and (string-match org-bracket-link-regexp blink)
- (match-string-no-properties 3 blink)) "No description"))
- (files (org-registry-assoc-all link))
- file point selection tmphist)
- (cond ((and files visit)
- ;; result(s) to visit
- (cond ((< 1 (length files))
- ;; more than one result
- (setq tmphist (mapcar (lambda(entry)
- (format "%s (%d) [%s]"
- (nth 3 entry) ; file
- (nth 2 entry) ; point
- (nth 1 entry))) files))
- (setq selection (completing-read "File: " tmphist
- nil t nil 'tmphist))
- (string-match "\\(.+\\) (\\([0-9]+\\))" selection)
- (setq file (match-string 1 selection))
- (setq point (string-to-number (match-string 2 selection))))
- ((eq 1 (length files))
- ;; just one result
- (setq file (nth 3 (car files)))
- (setq point (nth 2 (car files)))))
- ;; visit the (selected) file
- (funcall org-registry-find-file file)
- (goto-char point)
- (unless (org-before-first-heading-p)
- (org-show-context)))
- ((and files (not visit))
- ;; result(s) to display
- (cond ((eq 1 (length files))
- ;; show one file
- (message "Link in file %s (%d) [%s]"
- (nth 3 (car files))
- (nth 2 (car files))
- (nth 1 (car files))))
- (t (org-registry-display-files files link))))
- (t (message "No link to this in org-agenda-files")))))
-
-(defun org-registry-display-files (files link)
- "Display files in a separate window."
- (switch-to-buffer-other-window
- (get-buffer-create " *Org registry info*"))
- (erase-buffer)
- (insert (format "Files pointing to %s:\n\n" link))
- (let (file)
- (while (setq file (pop files))
- (insert (format "%s (%d) [%s]\n" (nth 3 file)
- (nth 2 file) (nth 1 file)))))
- (shrink-window-if-larger-than-buffer)
- (other-window 1))
-
-(defun org-registry-assoc-all (link &optional registry)
- "Return all associated entries of LINK in the registry."
- (org-registry-find-all
- (lambda (entry) (string= link (car entry)))
- registry))
-
-(defun org-registry-find-all (test &optional registry)
- "Return all entries satisfying `test' in the registry."
- (delq nil
- (mapcar
- (lambda (x) (and (funcall test x) x))
- (or registry org-registry-alist))))
-
-;;;###autoload
-(defun org-registry-visit ()
- "If an Org file contains a link to the current location, visit
-this file."
- (interactive)
- (org-registry-show t))
-
-;;;###autoload
-(defun org-registry-initialize (&optional from-scratch)
- "Initialize `org-registry-alist'.
-If FROM-SCRATCH is non-nil or the registry does not exist yet,
-create a new registry from scratch and eval it. If the registry
-exists, eval `org-registry-file' and make it the new value for
-`org-registry-alist'."
- (interactive "P")
- (if (or from-scratch (not (file-exists-p org-registry-file)))
- ;; create a new registry
- (let ((files org-agenda-files) file)
- (while (setq file (pop files))
- (setq file (expand-file-name file))
- (mapc (lambda (entry)
- (add-to-list 'org-registry-alist entry))
- (org-registry-get-entries file)))
- (when from-scratch
- (org-registry-create org-registry-alist)))
- ;; eval the registry file
- (with-temp-buffer
- (insert-file-contents org-registry-file)
- (eval-buffer))))
-
-;;;###autoload
-(defun org-registry-insinuate ()
- "Call `org-registry-update' after saving in Org-mode.
-Use with caution. This could slow down things a bit."
- (interactive)
- (add-hook 'org-mode-hook
- (lambda() (add-hook 'after-save-hook
- 'org-registry-update t t))))
-
-(defun org-registry-get-entries (file)
- "List Org links in FILE that will be put in the registry."
- (let (bufstr result)
- (with-temp-buffer
- (insert-file-contents file)
- (goto-char (point-min))
- (while (re-search-forward org-angle-link-re nil t)
- (let* ((point (match-beginning 0))
- (link (match-string-no-properties 0))
- (desc (match-string-no-properties 0)))
- (add-to-list 'result (list link desc point file))))
- (goto-char (point-min))
- (while (re-search-forward org-bracket-link-regexp nil t)
- (let* ((point (match-beginning 0))
- (link (match-string-no-properties 1))
- (desc (or (match-string-no-properties 3) "No description")))
- (add-to-list 'result (list link desc point file)))))
- ;; return the list of new entries
- result))
-
-;;;###autoload
-(defun org-registry-update ()
- "Update the registry for the current Org file."
- (interactive)
- (unless (org-mode-p) (error "Not in org-mode"))
- (let* ((from-file (expand-file-name (buffer-file-name)))
- (new-entries (org-registry-get-entries from-file)))
- (with-temp-buffer
- (unless (file-exists-p org-registry-file)
- (org-registry-initialize t))
- (find-file org-registry-file)
- (goto-char (point-min))
- (while (re-search-forward (concat from-file "\")$") nil t)
- (let ((end (1+ (match-end 0)))
- (beg (progn (re-search-backward "^(\"" nil t)
- (match-beginning 0))))
- (delete-region beg end)))
- (goto-char (point-min))
- (re-search-forward "^(\"" nil t)
- (goto-char (match-beginning 0))
- (mapc (lambda (elem)
- (insert (with-output-to-string (prin1 elem)) "\n"))
- new-entries)
- (save-buffer)
- (kill-buffer (current-buffer)))
- (message (format "Org registry updated for %s"
- (file-name-nondirectory from-file)))))
-
-(defun org-registry-create (entries)
- "Create `org-registry-file' with ENTRIES."
- (let (entry)
- (with-temp-buffer
- (find-file org-registry-file)
- (erase-buffer)
- (insert
- (with-output-to-string
- (princ ";; -*- emacs-lisp -*-\n")
- (princ ";; Org registry\n")
- (princ ";; You shouldn't try to modify this buffer manually\n\n")
- (princ "(setq org-registry-alist\n'(\n")
- (while entries
- (when (setq entry (pop entries))
- (prin1 entry)
- (princ "\n")))
- (princ "))\n")))
- (save-buffer)
- (kill-buffer (current-buffer))))
- (message "Org registry created"))
-
-(provide 'org-registry)
-
-;;; User Options, Variables
-
-;;; org-registry.el ends here
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-screen.el b/.emacs.d/org-7.4/contrib/lisp/org-screen.el
deleted file mode 100644
index fb1e73f..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-screen.el
+++ /dev/null
@@ -1,108 +0,0 @@
-;;; org-screen.el --- Integreate Org-mode with screen.
-
-;; Copyright (c) 2008 Andrew Hyatt
-;;
-;; Author: Andrew Hyatt <ahyatt at gmail dot com>
-;; Maintainer: Carsten Dominik <carsten at orgmode dot org>
-;;
-;; This file is not yet 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, 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; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-;;
-;; This file contains functionality to integrate screen and org-mode.
-;; When using org-mode, it is often useful to take tasks that have
-;; some command-line work associated with them, and associate them
-;; with a screen session. Screen is used rather than a direct
-;; terminal to facilitate portability of the resulting session.
-;;
-;; To use screen in org, in your .emacs file, simply put this file in
-;; a directory in your load-path and write:
-;;
-;; (require 'org-screen)
-;;
-;; When have a task and want to start some command-line activity
-;; associated with that task, go to the end of your item and type:
-;;
-;; M-x org-screen
-;;
-;; This will prompt you for a name of a screen session. Type in a
-;; name and it will insert a link into your org file at your current
-;; location.
-;;
-;; When you want to visit the link, go to the link and type C-c C-o to
-;; open the link.
-;;
-;; You may want to get rid of the constant queries about whether you
-;; really want to execute lisp code. Do so by adding to your .emacs:
-;;
-;; (setq org-confirm-elisp-link-function nil)
-
-(require 'term)
-(require 'org)
-
-(defcustom org-screen-program-name "/usr/bin/screen"
- "Full location of the screen executable."
- :group 'org-screen
- :type 'string)
-
-(defun org-screen (name)
- "Start a screen session with name"
- (interactive "MScreen name: ")
- (save-excursion
- (org-screen-helper name "-S"))
- (insert-string (concat "[[screen:" name "]]")))
-
-(defun org-screen-buffer-name (name)
- "Returns the buffer name corresponding to the screen name given."
- (concat "*screen " name "*"))
-
-(defun org-screen-helper (name arg)
- "This method will create a screen session with a specified name
-and taking the specified screen arguments. Much of this function
-is copied from ansi-term method."
-
- ;; Pick the name of the new buffer.
- (let ((term-ansi-buffer-name
- (generate-new-buffer-name
- (org-screen-buffer-name name))))
- (setq term-ansi-buffer-name
- (term-ansi-make-term
- term-ansi-buffer-name org-screen-program-name nil arg name))
- (set-buffer term-ansi-buffer-name)
- (term-mode)
- (term-char-mode)
- (term-set-escape-char ?\C-x)
- term-ansi-buffer-name))
-
-(defun org-screen-goto (name)
- "Open the screen with the specified name in the window"
- (interactive "MScreen name: ")
- (let ((screen-buffer-name (org-screen-buffer-name name)))
- (if (member screen-buffer-name
- (mapcar 'buffer-name (buffer-list)))
- (switch-to-buffer screen-buffer-name)
- (switch-to-buffer (org-screen-helper name "-dr")))))
-
-(if org-link-abbrev-alist
- (add-to-list 'org-link-abbrev-alist
- '("screen" . "elisp:(org-screen-goto \"%s\")"))
- (setq org-link-abbrev-alist
- '(("screen" . "elisp:(org-screen-goto \"%s\")"))))
-
-(provide 'org-screen)
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-secretary.el b/.emacs.d/org-7.4/contrib/lisp/org-secretary.el
deleted file mode 100644
index 353e5c3..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-secretary.el
+++ /dev/null
@@ -1,232 +0,0 @@
-;;; org-secretary.el --- Team management with org-mode
-;; Copyright (C) 2010 Juan Reyero
-;;
-;; Author: Juan Reyero <juan _at_ juanreyero _dot_ com>
-;; Keywords: outlines, tasks, team, management
-;; Homepage: http://juanreyero.com/article/emacs/org-teams.html
-;; Version: 0.02
-;;
-;; This file is not part of GNU Emacs.
-;;
-;; This file 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, or (at your option)
-;; any later version.
-
-;; THis file 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; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-;;
-;; This module implements helper functions for team management. It
-;; makes it easy to keep track of the work of several people. It
-;; keeps context (with whom and where you are) and allows you to use
-;; it to metadata to your notes, and to query the tasks associated
-;; with the people you are with and the place.
-;;
-;; See http://juanreyero.com/article/emacs/org-teams.html for a full
-;; explanation and configuration instructions.
-;;
-;;; Configuration
-;;;;;;;;;;;;;;;;;
-;;
-;; In short; your todos use the TODO keyword, your team's use TASK.
-;; Your org-todo-keywords should look something like this:
-;;
-;; (setq org-todo-keywords
-;; '((sequence "TODO(t)" "|" "DONE(d)" "CANCELLED(c)")
-;; (sequence "TASK(f)" "|" "DONE(d)")
-;; (sequence "MAYBE(m)" "|" "CANCELLED(c)")))
-;;
-;; It helps to distinguish them by color, like this:
-;;
-;; (setq org-todo-keyword-faces
-;; '(("TODO" . (:foreground "DarkOrange1" :weight bold))
-;; ("MAYBE" . (:foreground "sea green"))
-;; ("DONE" . (:foreground "light sea green"))
-;; ("CANCELLED" . (:foreground "forest green"))
-;; ("TASK" . (:foreground "blue"))))
-;;
-;; If you want to keep track of stuck projects you should tag your
-;; projects with :prj:, and define:
-;;
-;; (setq org-tags-exclude-from-inheritance '("prj")
-;; org-stuck-projects '("+prj/-MAYBE-DONE"
-;; ("TODO" "TASK") ()))
-;;
-;; Define a tag that marks TASK entries as yours:
-;;
-;; (setq org-sec-me "juanre")
-;;
-;; Finally, you add the special views to your org-agenda-custom-commands:
-;;
-;; (setq org-agenda-custom-commands
-;; '(("h" "Work todos" tags-todo
-;; "-personal-doat={.+}-dowith={.+}/!-TASK"
-;; ((org-agenda-todo-ignore-scheduled t)))
-;; ("H" "All work todos" tags-todo "-personal/!-TASK-MAYBE"
-;; ((org-agenda-todo-ignore-scheduled nil)))
-;; ("A" "Work todos with doat or dowith" tags-todo
-;; "-personal+doat={.+}|dowith={.+}/!-TASK"
-;; ((org-agenda-todo-ignore-scheduled nil)))
-;; ("j" "TODO dowith and TASK with"
-;; ((org-sec-with-view "TODO dowith")
-;; (org-sec-where-view "TODO doat")
-;; (org-sec-assigned-with-view "TASK with")
-;; (org-sec-stuck-with-view "STUCK with")))
-;; ("J" "Interactive TODO dowith and TASK with"
-;; ((org-sec-who-view "TODO dowith")))))
-;;
-;;; Usage
-;;;;;;;;;
-;;
-;; Do C-c w to say with whom you are meeting (a space-separated list
-;; of names). Maybe do also C-c W to say where you are. Then do C-c a
-;; j to see:
-;; - Todo items defined with TODO (ie, mine) in which the
-;; =dowith= property matches any of the people with me.
-;; - Todo items defined with TODO in which the =doat= property
-;; matches my current location.
-;; - Todo items defined with TASK that are tagged with the name
-;; of any of the people with me (this is, assigned to them).
-;; - Stuck projects tagged with the name of the people with me.
-;;
-;; Use C-c j to add meta-data with the people with me, the
-;; location and the time to entries.
-
-(require 'org)
-
-(defvar org-sec-me nil
- "Tag that defines TASK todo entries associated to me")
-
-(defvar org-sec-with nil
- "Value of the :with: property when doing an
- org-sec-tag-entry. Change it with org-sec-set-with,
- set to C-c w. Defaults to org-sec-me")
-
-(defvar org-sec-where ""
- "Value of the :at: property when doing an
- org-sec-tag-entry. Change it with org-sec-set-with,
- set to C-c W")
-
-(defvar org-sec-with-history '()
- "History list of :with: properties")
-
-(defvar org-sec-where-history '()
- "History list of :where: properties")
-
-(defun org-sec-set-with ()
- "Changes the value of the org-sec-with variable for use in the
- next call of org-sec-tag-entry. Leave it empty to default to
- org-sec-me (you)."
- (interactive)
- (setq org-sec-with (let ((w (read-string "With: " nil
- 'org-sec-with-history "")))
- (if (string= w "")
- nil
- w))))
-(global-set-key "\C-cw" 'org-sec-set-with)
-
-(defun org-sec-set-where ()
- "Changes the value of the org-sec-where variable for use
- in the next call of org-sec-tag-entry."
- (interactive)
- (setq org-sec-where
- (read-string "Where: " nil
- 'org-sec-where-history "")))
-(global-set-key "\C-cW" 'org-sec-set-where)
-
-(defun org-sec-set-dowith ()
- "Sets the value of the dowith property."
- (interactive)
- (let ((do-with
- (read-string "Do with: "
- nil 'org-sec-dowith-history "")))
- (unless (string= do-with "")
- (org-entry-put nil "dowith" do-with))))
-(global-set-key "\C-cd" 'org-sec-set-dowith)
-
-(defun org-sec-set-doat ()
- "Sets the value of the doat property."
- (interactive)
- (let ((do-at (read-string "Do at: "
- nil 'org-sec-doat-history "")))
- (unless (string= do-at "")
- (org-entry-put nil "doat" do-at))))
-(global-set-key "\C-cD" 'org-sec-set-doat)
-
-(defun org-sec-tag-entry ()
- "Adds a :with: property with the value of org-sec-with if
- defined, an :at: property with the value of org-sec-where
- if defined, and an :on: property with the current time."
- (interactive)
- (save-excursion
- (org-entry-put nil "on" (format-time-string
- (org-time-stamp-format 'long)
- (current-time)))
- (unless (string= org-sec-where "")
- (org-entry-put nil "at" org-sec-where))
- (if org-sec-with
- (org-entry-put nil "with" org-sec-with))))
-(global-set-key "\C-cj" 'org-sec-tag-entry)
-
-(defun join (lst sep &optional pre post)
- (mapconcat (function (lambda (x) (concat pre x post))) lst sep))
-
-(defun org-sec-get-with ()
- (if org-sec-with
- org-sec-with
- org-sec-me))
-
-(defun org-sec-with-view (par &optional who)
- "Select tasks marked as dowith=who, where who
- defaults to the value of org-sec-with."
- (org-tags-view '(4) (join (split-string (if who
- who
- (org-sec-get-with)))
- "|" "dowith=\"" "\"")))
-
-(defun org-sec-where-view (par)
- "Select tasks marked as doat=org-sec-where."
- (org-tags-view '(4) (concat "doat={" org-sec-where "}")))
-
-(defun org-sec-assigned-with-view (par &optional who)
- "Select tasks assigned to who, by default org-sec-with."
- (org-tags-view '(4)
- (concat (join (split-string (if who
- who
- (org-sec-get-with)))
- "|")
- "/TASK")))
-
-(defun org-sec-stuck-with-view (par &optional who)
- "Select stuck projects assigned to who, by default
- org-sec-with."
- (let ((org-stuck-projects
- `(,(concat "+prj+"
- (join (split-string (if who
- who
- (org-sec-get-with))) "|")
- "/-MAYBE-DONE")
- ("TODO" "TASK") ())))
- (org-agenda-list-stuck-projects)))
-
-(defun org-sec-who-view (par)
- "Builds agenda for a given user. Queried. "
- (let ((who (read-string "Build todo for user/tag: "
- "" "" "")))
- (org-sec-with-view "TODO dowith" who)
- (org-sec-assigned-with-view "TASK with" who)
- (org-sec-stuck-with-view "STUCK with" who)))
-
-(provide 'org-secretary)
-
-;;; org-secretary.el ends here
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-special-blocks.el b/.emacs.d/org-7.4/contrib/lisp/org-special-blocks.el
deleted file mode 100644
index 80e2b89..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-special-blocks.el
+++ /dev/null
@@ -1,94 +0,0 @@
-;;; org-special-blocks.el --- Turn blocks into LaTeX envs and HTML divs
-
-;; Copyright (C) 2009 Chris Gray
-
-;; Author: Chris Gray <chrismgray@gmail.com>
-
-;; This file is not currently part of GNU Emacs.
-
-;; 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 ; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-;;
-
-;; This package generalizes the #+begin_foo and #+end_foo tokens.
-
-;; To use, put the following in your init file:
-;;
-;; (require 'org-special-blocks)
-
-;; The tokens #+begin_center, #+begin_verse, etc. existed previously.
-;; This package generalizes them (at least for the LaTeX and html
-;; exporters). When a #+begin_foo token is encountered by the LaTeX
-;; exporter, it is expanded into \begin{foo}. The text inside the
-;; environment is not protected, as text inside environments generally
-;; is. When #+begin_foo is encountered by the html exporter, a div
-;; with class foo is inserted into the HTML file. It is up to the
-;; user to add this class to his or her stylesheet if this div is to
-;; mean anything.
-
-(defvar org-special-blocks-ignore-regexp "^\\(LaTeX\\|HTML\\)$"
- "A regexp indicating the names of blocks that should be ignored
-by org-special-blocks. These blocks will presumably be
-interpreted by other mechanisms.")
-
-(defun org-special-blocks-make-special-cookies ()
- "Adds special cookies when #+begin_foo and #+end_foo tokens are
-seen. This is run after a few special cases are taken care of."
- (when (or htmlp latexp)
- (goto-char (point-min))
- (while (re-search-forward "^[ \t]*#\\+\\(begin\\|end\\)_\\(.*\\)$" nil t)
- (unless (org-string-match-p org-special-blocks-ignore-regexp (match-string 2))
- (replace-match
- (if (equal (downcase (match-string 1)) "begin")
- (concat "ORG-" (match-string 2) "-START")
- (concat "ORG-" (match-string 2) "-END"))
- t t)))))
-
-(add-hook 'org-export-preprocess-after-blockquote-hook
- 'org-special-blocks-make-special-cookies)
-
-(defun org-special-blocks-convert-latex-special-cookies ()
- "Converts the special cookies into LaTeX blocks."
- (goto-char (point-min))
- (while (re-search-forward "^ORG-\\([^ \t\n]*\\)[ \t]*\\(.*\\)-\\(START\\|END\\)$" nil t)
- (replace-match
- (if (equal (match-string 3) "START")
- (concat "\\begin{" (match-string 1) "}" (match-string 2))
- (concat "\\end{" (match-string 1) "}"))
- t t)))
-
-
-(add-hook 'org-export-latex-after-blockquotes-hook
- 'org-special-blocks-convert-latex-special-cookies)
-
-(defun org-special-blocks-convert-html-special-cookies ()
- "Converts the special cookies into div blocks."
- ;; Uses the dynamically-bound variable `line'.
- (when (string-match "^ORG-\\(.*\\)-\\(START\\|END\\)$" line)
-; (org-close-par-maybe)
- (message "%s" (match-string 1))
- (if (equal (match-string 2 line) "START")
- (insert "<div class=\"" (match-string 1 line) "\">\n")
- (insert "</div>\n"))
- (throw 'nextline nil)))
-
-(add-hook 'org-export-html-after-blockquotes-hook
- 'org-special-blocks-convert-html-special-cookies)
-
-(provide 'org-special-blocks)
-
-;;; org-special-blocks.el ends here
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-static-mathjax.el b/.emacs.d/org-7.4/contrib/lisp/org-static-mathjax.el
deleted file mode 100644
index 6a9f0ec..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-static-mathjax.el
+++ /dev/null
@@ -1,171 +0,0 @@
-;;; org-static-mathjax.el --- Muse-like tags in Org-mode
-;;
-;; Author: Jan Böker <jan dot boecker at jboecker dot de>
-
-;; This elisp code integrates Static MathJax into the
-;; HTML export process of Org-mode.
-;;
-;; The supporting files for this package are in contrib/scripts/staticmathjax
-;; Please read the README.org file in that directory for more information.
-
-;; To use it, evaluate it on startup, add the following to your .emacs:
-
-;; (require 'org-static-mathjax)
-;;
-;; You will then have to customize the following two variables:
-;; - org-static-mathjax-app-ini-path
-;; - org-static-mathjax-local-mathjax-path
-;;
-;; If xulrunner is not in your $PATH, you will also need to customize
-;; org-static-mathjax-xulrunner-path.
-;;
-;; If everything is setup correctly, you can trigger Static MathJax on
-;; export to HTML by adding the following line to your Org file:
-;; #+StaticMathJax: embed-fonts:nil output-file-name:"embedded-math.html"
-;;
-;; You can omit either argument.
-;; embed-fonts defaults to nil. If you do not specify output-file-name,
-;; the exported file is overwritten with the static version.
-;;
-;; If embed-fonts is non-nil, the fonts are embedded directly into the
-;; output file using data: URIs.
-;;
-;; output-file-name specifies the file name of the static version. You
-;; can use any arbitrary lisp form here, for example:
-;; output-file-name:(concat (file-name-sans-extension buffer-file-name) "-static.html")
-;;
-;; The StaticMathJax XULRunner application expects a UTF-8 encoded
-;; input file. If the static version displays random characters instead
-;; of your math, add the following line at the top of your Org file:
-;; -*- coding: utf-8; -*-
-;;
-;; License: GPL v2 or later
-
-(defcustom org-static-mathjax-app-ini-path
- (or (expand-file-name
- "../scripts/staticmatchjax/application.ini"
- (file-name-directory (or load-file-name buffer-file-name)))
- "")
- "Path to \"application.ini\" of the Static MathJax XULRunner application.
-If you have extracted StaticMathJax to e.g. ~/.local/staticmathjax, set
-this to ~/.local/staticmathjax/application.ini"
- :type 'string)
-
-(defcustom org-static-mathjax-xulrunner-path
- "xulrunner"
- "Path to your xulrunner binary"
- :type 'string)
-
-(defcustom org-static-mathjax-local-mathjax-path
- ""
- "Extract the MathJax zip file somewhere on your local
-hard drive and specify the path here.
-
-The directory has to be writeable, as org-static-mathjax
-creates a temporary file there during export."
- :type 'string)
-
-(defvar org-static-mathjax-debug
- nil
- "If non-nil, org-static-mathjax will print some debug messages")
-
-(defun org-static-mathjax-hook-installer ()
- "Installs org-static-mathjax-process in after-save-hook.
-
-Sets the following buffer-local variables for org-static-mathjax-process to pick up:
-org-static-mathjax-mathjax-path: The path to MathJax.js as used by Org HTML export
-org-static-mathjax-options: The string given with #+STATICMATHJAX: in the file"
- (let ((static-mathjax-option-string (plist-get opt-plist :static-mathjax)))
- (if static-mathjax-option-string
- (progn (set (make-local-variable 'org-static-mathjax-options) static-mathjax-option-string)
- (set (make-local-variable 'org-static-mathjax-mathjax-path)
- (nth 1 (assq 'path org-export-html-mathjax-options)))
- (let ((mathjax-options (plist-get opt-plist :mathjax)))
- (if mathjax-options
- (if (string-match "\\<path:" mathjax-options)
- (set 'org-static-mathjax-mathjax-path
- (car (read-from-string
- (substring mathjax-options (match-end 0))))))))
- (add-hook 'after-save-hook
- 'org-static-mathjax-process
- nil t)))))
-
-
-(defun org-static-mathjax-process ()
- (save-excursion
- ; some sanity checking
- (if (or (string= org-static-mathjax-app-ini-path "")
- (not (file-exists-p org-static-mathjax-app-ini-path)))
- (error "Static MathJax: You must customize org-static-mathjax-app-ini-path!"))
- (if (or (string= org-static-mathjax-local-mathjax-path "")
- (not (file-exists-p org-static-mathjax-local-mathjax-path)))
- (error "Static MathJax: You must customize org-static-mathjax-local-mathjax-path!"))
-
- ; define variables
- (let* ((options org-static-mathjax-options)
- (output-file-name buffer-file-name)
- (input-file-name (let ((temporary-file-directory (file-name-directory org-static-mathjax-local-mathjax-path)))
- (make-temp-file "org-static-mathjax-" nil ".html")))
- (html-code (buffer-string))
- (mathjax-oldpath (concat "src=\"" org-static-mathjax-mathjax-path))
- (mathjax-newpath (concat "src=\"" org-static-mathjax-local-mathjax-path))
- embed-fonts)
- ; read file-local options
- (mapc
- (lambda (symbol)
- (if (string-match (concat "\\<" (symbol-name symbol) ":") options)
- (set symbol (eval (car (read-from-string
- (substring options (match-end 0))))))))
- '(embed-fonts output-file-name))
-
- ; debug
- (when org-static-mathjax-debug
- (message "output file name, embed-fonts")
- (print output-file-name)
- (print embed-fonts))
-
- ; open (temporary) input file, copy contents there, replace MathJax path with local installation
- (with-temp-buffer
- (insert html-code)
- (goto-char 1)
- (replace-regexp mathjax-oldpath mathjax-newpath)
- (write-file input-file-name))
-
- ; prepare argument list for call-process
- (let ((call-process-args (list org-static-mathjax-xulrunner-path
- nil nil nil
- org-static-mathjax-app-ini-path
- input-file-name
- output-file-name)))
- ; if fonts are embedded, just append the --embed-fonts flag
- (if embed-fonts
- (add-to-list 'call-process-args "--embed-fonts" t))
- ; if fonts are not embedded, the XULRunner app must replace all references
- ; to the font files with the real location (Firefox inserts file:// URLs there,
- ; because we are using a local MathJax installation here)
- (if (not embed-fonts)
- (progn
- (add-to-list 'call-process-args "--final-mathjax-url" t)
- (add-to-list 'call-process-args
- (file-name-directory org-static-mathjax-mathjax-path)
- t)))
-
- ; debug
- (when org-static-mathjax-debug
- (print call-process-args))
- ; call it
- (apply 'call-process call-process-args)
- ; delete our temporary input file
- (kill-buffer)
- (delete-file input-file-name)
- (let ((backup-file (concat input-file-name "~")))
- (if (file-exists-p backup-file)
- (delete-file backup-file)))))))
-
-(add-to-list 'org-export-inbuffer-options-extra
-'("STATICMATHJAX" :static-mathjax))
-
-(add-hook 'org-export-html-final-hook 'org-static-mathjax-hook-installer)
-
-
-(provide 'org-static-mathjax)
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-toc.el b/.emacs.d/org-7.4/contrib/lisp/org-toc.el
deleted file mode 100644
index 2c5eb9c..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-toc.el
+++ /dev/null
@@ -1,488 +0,0 @@
-;;; org-toc.el --- Table of contents for Org-mode buffer
-
-;; Copyright 2007 Bastien Guerry
-;;
-;; Author: Bastien Guerry <bzg AT altern DOT org>
-;; Keywords: Org table of contents
-;; Homepage: http://www.cognition.ens.fr/~guerry/u/org-toc.el
-;; Version: 0.8
-
-;; 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 3, 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, write to the Free Software
-;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; This library implements a browsable table of contents for Org files.
-
-;; Put this file into your load-path and the following into your ~/.emacs:
-;; (require 'org-toc)
-
-;;; Code:
-
-(provide 'org-toc)
-(eval-when-compile
- (require 'cl))
-
-;;; Custom variables:
-(defvar org-toc-base-buffer nil)
-(defvar org-toc-columns-shown nil)
-(defvar org-toc-odd-levels-only nil)
-(defvar org-toc-config-alist nil)
-(defvar org-toc-cycle-global-status nil)
-(defalias 'org-show-table-of-contents 'org-toc-show)
-
-(defgroup org-toc nil
- "Options concerning the browsable table of contents of Org-mode."
- :tag "Org TOC"
- :group 'org)
-
-(defcustom org-toc-default-depth 1
- "Default depth when invoking `org-toc-show' without argument."
- :group 'org-toc
- :type '(choice
- (const :tag "same as base buffer" nil)
- (integer :tag "level")))
-
-(defcustom org-toc-follow-mode nil
- "Non-nil means navigating through the table of contents will
-move the point in the Org buffer accordingly."
- :group 'org-toc
- :type 'boolean)
-
-(defcustom org-toc-info-mode nil
- "Non-nil means navigating through the table of contents will
-show the properties for the current headline in the echo-area."
- :group 'org-toc
- :type 'boolean)
-
-(defcustom org-toc-show-subtree-mode nil
- "Non-nil means show subtree when going to headline or following
-it while browsing the table of contents."
- :group 'org-toc
- :type '(choice
- (const :tag "show subtree" t)
- (const :tag "show entry" nil)))
-
-(defcustom org-toc-recenter-mode t
- "Non-nil means recenter the Org buffer when following the
-headlines in the TOC buffer."
- :group 'org-toc
- :type 'boolean)
-
-(defcustom org-toc-recenter 0
- "Where to recenter the Org buffer when unfolding a subtree.
-This variable is only used when `org-toc-recenter-mode' is set to
-'custom. A value >=1000 will call recenter with no arg."
- :group 'org-toc
- :type 'integer)
-
-(defcustom org-toc-info-exclude '("ALLTAGS")
- "A list of excluded properties when displaying info in the
-echo-area. The COLUMNS property is always exluded."
- :group 'org-toc
- :type 'lits)
-
-;;; Org TOC mode:
-(defvar org-toc-mode-map (make-sparse-keymap)
- "Keymap for `org-toc-mode'.")
-
-(defun org-toc-mode ()
- "A major mode for browsing the table of contents of an Org buffer.
-
-\\{org-toc-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (use-local-map org-toc-mode-map)
- (setq mode-name "Org TOC")
- (setq major-mode 'org-toc-mode))
-
-;; toggle modes
-(define-key org-toc-mode-map "f" 'org-toc-follow-mode)
-(define-key org-toc-mode-map "S" 'org-toc-show-subtree-mode)
-(define-key org-toc-mode-map "s" 'org-toc-store-config)
-(define-key org-toc-mode-map "g" 'org-toc-restore-config)
-(define-key org-toc-mode-map "i" 'org-toc-info-mode)
-(define-key org-toc-mode-map "r" 'org-toc-recenter-mode)
-
-;; navigation keys
-(define-key org-toc-mode-map "p" 'org-toc-previous)
-(define-key org-toc-mode-map "n" 'org-toc-next)
-(define-key org-toc-mode-map [(left)] 'org-toc-previous)
-(define-key org-toc-mode-map [(right)] 'org-toc-next)
-(define-key org-toc-mode-map [(up)] 'org-toc-previous)
-(define-key org-toc-mode-map [(down)] 'org-toc-next)
-(define-key org-toc-mode-map "1" (lambda() (interactive) (org-toc-show 1 (point))))
-(define-key org-toc-mode-map "2" (lambda() (interactive) (org-toc-show 2 (point))))
-(define-key org-toc-mode-map "3" (lambda() (interactive) (org-toc-show 3 (point))))
-(define-key org-toc-mode-map "4" (lambda() (interactive) (org-toc-show 4 (point))))
-(define-key org-toc-mode-map " " 'org-toc-goto)
-(define-key org-toc-mode-map "q" 'org-toc-quit)
-(define-key org-toc-mode-map "x" 'org-toc-quit)
-;; go to the location and stay in the base buffer
-(define-key org-toc-mode-map [(tab)] 'org-toc-jump)
-(define-key org-toc-mode-map "v" 'org-toc-jump)
-;; go to the location and delete other windows
-(define-key org-toc-mode-map [(return)]
- (lambda() (interactive) (org-toc-jump t)))
-
-;; special keys
-(define-key org-toc-mode-map "c" 'org-toc-columns)
-(define-key org-toc-mode-map "?" 'org-toc-help)
-(define-key org-toc-mode-map ":" 'org-toc-cycle-subtree)
-(define-key org-toc-mode-map "\C-c\C-o" 'org-open-at-point)
-;; global cycling in the base buffer
-(define-key org-toc-mode-map (kbd "C-S-<iso-lefttab>")
- 'org-toc-cycle-base-buffer)
-;; subtree cycling in the base buffer
-(define-key org-toc-mode-map [(control tab)]
- (lambda() (interactive) (org-toc-goto nil t)))
-
-;;; Toggle functions:
-(defun org-toc-follow-mode ()
- "Toggle follow mode in a `org-toc-mode' buffer."
- (interactive)
- (setq org-toc-follow-mode (not org-toc-follow-mode))
- (message "Follow mode is %s"
- (if org-toc-follow-mode "on" "off")))
-
-(defun org-toc-info-mode ()
- "Toggle info mode in a `org-toc-mode' buffer."
- (interactive)
- (setq org-toc-info-mode (not org-toc-info-mode))
- (message "Info mode is %s"
- (if org-toc-info-mode "on" "off")))
-
-(defun org-toc-show-subtree-mode ()
- "Toggle show subtree mode in a `org-toc-mode' buffer."
- (interactive)
- (setq org-toc-show-subtree-mode (not org-toc-show-subtree-mode))
- (message "Show subtree mode is %s"
- (if org-toc-show-subtree-mode "on" "off")))
-
-(defun org-toc-recenter-mode (&optional line)
- "Toggle recenter mode in a `org-toc-mode' buffer. If LINE is
-specified, then make `org-toc-recenter' use this value."
- (interactive "P")
- (setq org-toc-recenter-mode (not org-toc-recenter-mode))
- (when (numberp line)
- (setq org-toc-recenter-mode t)
- (setq org-toc-recenter line))
- (message "Recenter mode is %s"
- (if org-toc-recenter-mode
- (format "on, line %d" org-toc-recenter) "off")))
-
-(defun org-toc-cycle-subtree ()
- "Locally cycle a headline through two states: 'children and
-'folded"
- (interactive)
- (let ((beg (point))
- (end (save-excursion (end-of-line) (point)))
- (ov (car (overlays-at (point))))
- status)
- (if ov (setq status (overlay-get ov 'status))
- (setq ov (make-overlay beg end)))
- ;; change the folding status of this headline
- (cond ((or (null status) (eq status 'folded))
- (show-children)
- (message "CHILDREN")
- (overlay-put ov 'status 'children))
- ((eq status 'children)
- (show-branches)
- (message "BRANCHES")
- (overlay-put ov 'status 'branches))
- (t (hide-subtree)
- (message "FOLDED")
- (overlay-put ov 'status 'folded)))))
-
-;;; Main show function:
-;; FIXME name this org-before-first-heading-p?
-(defun org-toc-before-first-heading-p ()
- "Before first heading?"
- (save-excursion
- (null (re-search-backward "^\\*+ " nil t))))
-
-;;;###autoload
-(defun org-toc-show (&optional depth position)
- "Show the table of contents of the current Org-mode buffer."
- (interactive "P")
- (if (org-mode-p)
- (progn (setq org-toc-base-buffer (current-buffer))
- (setq org-toc-odd-levels-only org-odd-levels-only))
- (if (eq major-mode 'org-toc-mode)
- (switch-to-buffer org-toc-base-buffer)
- (error "Not in an Org buffer")))
- ;; create the new window display
- (let ((pos (or position
- (save-excursion
- (if (org-toc-before-first-heading-p)
- (progn (re-search-forward "^\\*+ " nil t)
- (match-beginning 0))
- (point))))))
- (setq org-toc-cycle-global-status org-cycle-global-status)
- (delete-other-windows)
- (and (get-buffer "*org-toc*") (kill-buffer "*org-toc*"))
- (switch-to-buffer-other-window
- (make-indirect-buffer org-toc-base-buffer "*org-toc*"))
- ;; make content before 1st headline invisible
- (goto-char (point-min))
- (let* ((beg (point-min))
- (end (and (re-search-forward "^\\*" nil t)
- (1- (match-beginning 0))))
- (ov (make-overlay beg end))
- (help (format "Table of contents for %s (press ? for a quick help):\n"
- (buffer-name org-toc-base-buffer))))
- (overlay-put ov 'invisible t)
- (overlay-put ov 'before-string help))
- ;; build the browsable TOC
- (cond (depth
- (let* ((dpth (if org-toc-odd-levels-only
- (1- (* depth 2)) depth)))
- (org-content dpth)
- (setq org-toc-cycle-global-status
- `(org-content ,dpth))))
- ((null org-toc-default-depth)
- (if (eq org-toc-cycle-global-status 'overview)
- (progn (org-overview)
- (setq org-cycle-global-status 'overview)
- (run-hook-with-args 'org-cycle-hook 'overview))
- (progn (org-overview)
- ;; FIXME org-content to show only headlines?
- (org-content)
- (setq org-cycle-global-status 'contents)
- (run-hook-with-args 'org-cycle-hook 'contents))))
- (t (let* ((dpth0 org-toc-default-depth)
- (dpth (if org-toc-odd-levels-only
- (1- (* dpth0 2)) dpth0)))
- (org-content dpth)
- (setq org-toc-cycle-global-status
- `(org-content ,dpth)))))
- (goto-char pos))
- (move-beginning-of-line nil)
- (org-toc-mode)
- (shrink-window-if-larger-than-buffer)
- (setq buffer-read-only t))
-
-;;; Navigation functions:
-(defun org-toc-goto (&optional jump cycle)
- "From Org TOC buffer, follow the targeted subtree in the Org window.
-If JUMP is non-nil, go to the base buffer.
-If JUMP is 'delete, go to the base buffer and delete other windows.
-If CYCLE is non-nil, cycle the targeted subtree in the Org window."
- (interactive)
- (let ((pos (point))
- (toc-buf (current-buffer)))
- (switch-to-buffer-other-window org-toc-base-buffer)
- (goto-char pos)
- (if cycle (org-cycle)
- (progn (org-overview)
- (if org-toc-show-subtree-mode
- (org-show-subtree)
- (org-show-entry))
- (org-show-context)))
- (if org-toc-recenter-mode
- (if (>= org-toc-recenter 1000) (recenter)
- (recenter org-toc-recenter)))
- (cond ((null jump)
- (switch-to-buffer-other-window toc-buf))
- ((eq jump 'delete)
- (delete-other-windows)))))
-
-(defun org-toc-cycle-base-buffer ()
- "Call `org-cycle' with a prefix argument in the base buffer."
- (interactive)
- (switch-to-buffer-other-window org-toc-base-buffer)
- (org-cycle t)
- (other-window 1))
-
-(defun org-toc-jump (&optional delete)
- "From Org TOC buffer, jump to the targeted subtree in the Org window.
-If DELETE is non-nil, delete other windows when in the Org buffer."
- (interactive "P")
- (if delete (org-toc-goto 'delete)
- (org-toc-goto t)))
-
-(defun org-toc-previous ()
- "Go to the previous headline of the TOC."
- (interactive)
- (if (save-excursion
- (beginning-of-line)
- (re-search-backward "^\\*" nil t))
- (outline-previous-visible-heading 1)
- (message "No previous heading"))
- (if org-toc-info-mode (org-toc-info))
- (if org-toc-follow-mode (org-toc-goto)))
-
-(defun org-toc-next ()
- "Go to the next headline of the TOC."
- (interactive)
- (outline-next-visible-heading 1)
- (if org-toc-info-mode (org-toc-info))
- (if org-toc-follow-mode (org-toc-goto)))
-
-(defun org-toc-quit ()
- "Quit the current Org TOC buffer."
- (interactive)
- (kill-this-buffer)
- (other-window 1)
- (delete-other-windows))
-
-;;; Special functions:
-(defun org-toc-columns ()
- "Toggle columns view in the Org buffer from Org TOC."
- (interactive)
- (let ((indirect-buffer (current-buffer)))
- (switch-to-buffer org-toc-base-buffer)
- (if (not org-toc-columns-shown)
- (progn (org-columns)
- (setq org-toc-columns-shown t))
- (progn (org-columns-remove-overlays)
- (setq org-toc-columns-shown nil)))
- (switch-to-buffer indirect-buffer)))
-
-(defun org-toc-info ()
- "Show properties of current subtree in the echo-area."
- (interactive)
- (let ((pos (point))
- (indirect-buffer (current-buffer))
- props prop msg)
- (switch-to-buffer org-toc-base-buffer)
- (goto-char pos)
- (setq props (org-entry-properties))
- (while (setq prop (pop props))
- (unless (or (equal (car prop) "COLUMNS")
- (member (car prop) org-toc-info-exclude))
- (let ((p (car prop))
- (v (cdr prop)))
- (if (equal p "TAGS")
- (setq v (mapconcat 'identity (split-string v ":" t) " ")))
- (setq p (concat p ":"))
- (add-text-properties 0 (length p) '(face org-special-keyword) p)
- (setq msg (concat msg p " " v " ")))))
- (switch-to-buffer indirect-buffer)
- (message msg)))
-
-;;; Store and restore TOC configuration:
-(defun org-toc-store-config ()
- "Store the current status of the tables of contents in
-`org-toc-config-alist'."
- (interactive)
- (let ((file (buffer-file-name org-toc-base-buffer))
- (pos (point))
- (hlcfg (org-toc-get-headlines-status)))
- (setq org-toc-config-alist
- (delete (assoc file org-toc-config-alist)
- org-toc-config-alist))
- (add-to-list 'org-toc-config-alist
- `(,file ,pos ,org-toc-cycle-global-status ,hlcfg))
- (message "TOC configuration saved: (%s)"
- (if (listp org-toc-cycle-global-status)
- (concat "org-content "
- (number-to-string
- (cadr org-toc-cycle-global-status)))
- (symbol-name org-toc-cycle-global-status)))))
-
-(defun org-toc-restore-config ()
- "Get the stored status in `org-toc-config-alist' and set the
-current table of contents to it."
- (interactive)
- (let* ((file (buffer-file-name org-toc-base-buffer))
- (conf (cdr (assoc file org-toc-config-alist)))
- (pos (car conf))
- (status (cadr conf))
- (hlcfg (caddr conf)) hlcfg0 ov)
- (cond ((listp status)
- (org-toc-show (cadr status) (point)))
- ((eq status 'overview)
- (org-overview)
- (setq org-cycle-global-status 'overview)
- (run-hook-with-args 'org-cycle-hook 'overview))
- (t
- (org-overview)
- (org-content)
- (setq org-cycle-global-status 'contents)
- (run-hook-with-args 'org-cycle-hook 'contents)))
- (while (setq hlcfg0 (pop hlcfg))
- (save-excursion
- (goto-char (point-min))
- (when (search-forward (car hlcfg0) nil t)
- (unless (overlays-at (match-beginning 0))
- (setq ov (make-overlay (match-beginning 0)
- (match-end 0))))
- (cond ((eq (cdr hlcfg0) 'children)
- (show-children)
- (message "CHILDREN")
- (overlay-put ov 'status 'children))
- ((eq (cdr hlcfg0) 'branches)
- (show-branches)
- (message "BRANCHES")
- (overlay-put ov 'status 'branches))))))
- (goto-char pos)
- (if org-toc-follow-mode (org-toc-goto))
- (message "Last TOC configuration restored")
- (sit-for 1)
- (if org-toc-info-mode (org-toc-info))))
-
-(defun org-toc-get-headlines-status ()
- "Return an alist of headlines and their associated folding
-status."
- (let (output ovs)
- (save-excursion
- (goto-char (point-min))
- (while (and (not (eobp))
- (goto-char (next-overlay-change (point))))
- (when (looking-at "^\\*+ ")
- (add-to-list
- 'output
- (cons (buffer-substring-no-properties
- (match-beginning 0)
- (save-excursion
- (end-of-line) (point)))
- (overlay-get
- (car (overlays-at (point))) 'status))))))
- ;; return an alist like (("* Headline" . 'status))
- output))
-
-;; In Org TOC buffer, hide headlines below the first level.
-(defun org-toc-help ()
- "Display a quick help message in the echo-area for `org-toc-mode'."
- (interactive)
- (let ((st-start 0)
- (help-message
- "\[space\] show heading \[1-4\] hide headlines below this level
-\[TAB\] jump to heading \[f\] toggle follow mode (currently %s)
-\[return\] jump and delete others windows \[i\] toggle info mode (currently %s)
-\[S-TAB\] cycle subtree (in Org) \[S\] toggle show subtree mode (currently %s)
-\[C-S-TAB\] global cycle (in Org) \[r\] toggle recenter mode (currently %s)
-\[:\] cycle subtree (in TOC) \[c\] toggle column view (currently %s)
-\[n/p\] next/previous heading \[s\] save TOC configuration
-\[q\] quit the TOC \[g\] restore last TOC configuration"))
- (while (string-match "\\[[^]]+\\]" help-message st-start)
- (add-text-properties (match-beginning 0)
- (match-end 0) '(face bold) help-message)
- (setq st-start (match-end 0)))
- (message help-message
- (if org-toc-follow-mode "on" "off")
- (if org-toc-info-mode "on" "off")
- (if org-toc-show-subtree-mode "on" "off")
- (if org-toc-recenter-mode (format "on, line %s" org-toc-recenter) "off")
- (if org-toc-columns-shown "on" "off"))))
-
-
-;;;;##########################################################################
-;;;; User Options, Variables
-;;;;##########################################################################
-
-
-
-;;; org-toc.el ends here
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-track.el b/.emacs.d/org-7.4/contrib/lisp/org-track.el
deleted file mode 100644
index e65364e..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-track.el
+++ /dev/null
@@ -1,219 +0,0 @@
-;;; org-track.el --- Track the most recent Org-mode version available.
-;;
-;; Copyright (C) 2009
-;; Free Software Foundation, Inc.
-;;
-;; Author: Bastien Guerry <bzg at altern dot org>
-;; Eric S Fraga <e.fraga at ucl.ac dot uk>
-;; Sebastian Rose <sebastian_rose at gmx dot de>
-;; The Worg people http://orgmode.org/worg/
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: http://orgmode.org
-;; Version: 6.29a
-;;
-;; Released under the GNU General Public License version 3
-;; see: http://www.gnu.org/licenses/gpl-3.0.html
-;;
-;; This file is 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:
-;;
-;; Download the latest development tarball, unpack and optionally compile it
-;;
-;; Usage:
-;;
-;; (require 'org-track)
-;;
-;; ;; ... somewhere in your setup (use customize):
-;;
-;; (setq org-track-directory "~/test/")
-;; (setq org-track-compile-sources nil)
-;; (setq org-track-remove-package t)
-;;
-;; M-x org-track-update RET
-
-
-
-(require 'url-parse)
-(require 'url-handlers)
-(autoload 'url-file-local-copy "url-handlers")
-(autoload 'url-generic-parse-url "url-parse")
-
-
-
-
-
-;;; Variables:
-
-(defgroup org-track nil
- "Track the most recent Org-mode version available.
-
-To use org-track, adjust `org-track-directory'.
-Org will download the archived latest git version for you,
-unpack it into that directory (i.e. a subdirectory
-`org-mode/' is added), create the autoloads file
-`org-install.el' for you and, optionally, compile the
-sources.
-All you'll have to do is call `M-x org-track-update' from
-time to time."
- :version "22.1"
- :group 'org)
-
-(defcustom org-track-directory "~/.emacs.d/org/lisp"
- "Directory where your org-mode/ directory lives.
-If that directory does not exist, it will be created."
- :type 'directory)
-
-(defcustom org-track-compile-sources t
- "If `nil', never compile org-sources.
-Org will only create the autoloads file `org-install.el' for
-you then. If `t', compile the sources, too.
-Note, that emacs preferes compiled elisp files over
-non-compiled ones."
- :type 'boolean)
-
-(defcustom org-track-org-url "http://orgmode.org/"
- "The URL where the package to download can be found.
-Please append a slash."
- :type 'string)
-
-(defcustom org-track-org-package "org-latest.tar.gz"
- "The basename of the package you use.
-Defaults to the development version of Org-mode.
-This should be a *.tar.gz package, since emacs provides all
-you need to unpack it."
- :type 'string)
-
-(defcustom org-track-remove-package nil
- "Remove org-latest.tar.gz after updates?"
- :type 'boolean)
-
-
-
-
-
-;;; Frontend
-
-(defun org-track-update ()
- "Update to current Org-mode version.
-Also, generate autoloads and evtl. compile the sources."
- (interactive)
- (let* ((base (file-truename org-track-directory))
- (org-exists (file-exists-p
- (file-truename
- (concat base "/org-mode/lisp/org.el"))))
- (nobase (not (file-directory-p
- (file-truename org-track-directory)))))
- (if nobase
- (when (y-or-n-p
- (format "Directory %s does not exist. Create it?" base))
- (make-directory base t)
- (setq nobase nil)))
- (if nobase
- (message "Not creating %s - giving up." org-track-directory)
- (condition-case err
- (progn
- (org-track-fetch-package)
- (org-track-compile-org))
- (error (message "%s" (error-message-string err)))))))
-
-
-
-
-;;; tar related functions
-
-;; `url-retrieve-synchronously' fetches files synchronously. How can we ensure
-;; that? If the maintainers of that package decide, that an assynchronous
-;; download might be better??? (used by `url-file-local-copy')
-
-;;;###autoload
-(defun org-track-fetch-package (&optional directory)
- "Fetch Org package depending on `org-track-fetch-package-extension'.
-If DIRECTORY is defined, unpack the package there, i.e. add the
-subdirectory org-mode/ to DIRECTORY."
- (interactive "Dorg-track directory: ")
- (let* ((pack (concat
- (if (string-match "/$" org-track-org-url)
- org-track-org-url
- (concat org-track-org-url "/"))
- org-track-org-package))
- (base (file-truename
- (or directory org-track-directory)))
- (target (file-truename
- (concat base "/" org-track-org-package)))
- url download tarbuff)
- (message "Fetching to %s - this might take some time..." base)
- (setq url (url-generic-parse-url pack))
- (setq download (url-file-local-copy url)) ;; errors if fail
- (copy-file download target t)
- (delete-file download)
- ;; (tar-mode) leads to dubious errors. We use the auto-mode-alist to
- ;; ensure tar-mode is used:
- (add-to-list 'auto-mode-alist '("org-latest\\.tar\\.gz\\'" . tar-mode))
- (setq tarbuff (find-file target))
- (with-current-buffer tarbuff ;; with-temp-buffer does not work with tar-mode??
- (tar-untar-buffer))
- (kill-buffer tarbuff)
- (if org-track-remove-package
- (delete-file target))))
-
-
-
-
-;;; Compile Org-mode sources
-
-
-;;;###autoload
-(defun org-track-compile-org (&optional directory)
- "Compile all *.el files that come with org-mode.
-Generate the autoloads file `org-install.el'.
-
-DIRECTORY is where the directory org-mode/ lives (i.e. the
- parent directory of your local repo."
- (interactive)
- ;; file-truename expands the filename and removes double slash, if exists:
- (setq directory (file-truename
- (concat
- (or directory
- (file-truename (concat org-track-directory "/org-mode/lisp")))
- "/")))
- (add-to-list 'load-path directory)
- (let ((list-of-org-files (file-expand-wildcards (concat directory "*.el"))))
- ;; create the org-install file
- (require 'autoload)
- (setq esf/org-install-file (concat directory "org-install.el"))
- (find-file esf/org-install-file)
- (erase-buffer)
- (mapc (lambda (x)
- (generate-file-autoloads x))
- list-of-org-files)
- (insert "\n(provide (quote org-install))\n")
- (save-buffer)
- (kill-buffer)
- (byte-compile-file esf/org-install-file t)
-
- (mapc (lambda (f)
- (if (file-exists-p (concat f "c"))
- (delete-file (concat f "c"))))
- list-of-org-files)
- (if org-track-compile-sources
- (mapc (lambda (f) (byte-compile-file f)) list-of-org-files))))
-
-
-(provide 'org-track)
-
-;;; org-track.el ends here
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-velocity.el b/.emacs.d/org-7.4/contrib/lisp/org-velocity.el
deleted file mode 100644
index 2a1f41b..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-velocity.el
+++ /dev/null
@@ -1,527 +0,0 @@
-;;; org-velocity.el --- something like Notational Velocity for Org.
-
-;; Copyright (C) 2010 Paul M. Rodriguez
-
-;; Author: Paul M. Rodriguez <paulmrodriguez@gmail.com>
-;; Created: 2010-05-05
-;; Version: 2.2
-
-;; This file is not part of GNU Emacs.
-
-;; 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 version 2.
-
-;; 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.
-
-;; For a copy of the GNU General Public License, search the Internet,
-;; or write to the Free Software Foundation, Inc., 59 Temple Place,
-;; Suite 330, Boston, MA 02111-1307 USA
-
-;;; Commentary:
-;; Org-Velocity.el implements an interface for Org inspired by the
-;; minimalist notetaking program Notational Velocity. The idea is to
-;; allow you to maintain, amass and access brief notes on many
-;; subjects with minimal fuss.
-
-;; It can be used in two ways: to store and access notes from any
-;; buffer a universal bucket file; or as a method for navigating any
-;; Org file.
-
-;; The name of the bucket-file (`org-velocity-bucket') and whether to
-;; always use it (`org-velocity-always-use-bucket-file') are set
-;; through Customize. If the bucket file is set but not always to be
-;; used, then calling Org-Velocity outside of Org-mode uses the bucket
-;; file; calling it in Org mode uses the current buffer. If no bucket
-;; file is set then Org-Velocity only works when called from Org.
-;; Even if the bucket file is always to be used, calling
-;; `org-velocity-read' with an argument will use the current file.
-
-;; The interface, unlike its inspiration, is not incremental.
-;; Org-Velocity prompts for search terms in the usual way; if the user
-;; has customized `org-velocity-use-completion', completion is offered
-;; on the headings in the target file. If the search multiple times
-;; in the target file, a buffer containing a buttonized list of the
-;; headings where it occurs is displayed. Results beyond what can be
-;; indexed are discarded. After clicking on a heading, or typing a
-;; character associated with it, the user is taken to the heading.
-;; (Typing 0 forces a new heading to be created.) If
-;; `org-velocity-edit-indirectly' is so set, the heading and its
-;; subtree are displayed in an indirect buffer. Otherwise the user is
-;; simply taken to the proper buffer and position.
-
-;; If the user simply hits RET at the prompt, without making a choice,
-;; then the search is restored for editing. A blank search quits.
-;; This method of selection is obviously not as slick as the original,
-;; but probably more useful for a keyboard-driven interface.
-
-;; If the search does not occur in the file the user is offered a
-;; choice to create a new heading named with the search. Org-Velocity
-;; will use `org-capture' or `org-remember' if they are loaded,
-;; preferring `org-capture'. Otherwise the user is simply taken to a
-;; new heading at the end of the file.
-
-;; Thanks to Richard Riley, Carsten Dominik, and Bastien Guerry for
-;; their suggestions.
-
-;;; Usage:
-;; (require 'org-velocity)
-;; (setq org-velocity-bucket (concat org-directory "/bucket.org"))
-;; (global-set-key (kbd "C-c v") 'org-velocity-read)
-
-;;; Code:
-(require 'org)
-(require 'button)
-(require 'electric)
-(eval-when-compile (require 'cl))
-
-(defgroup org-velocity nil
- "Notational Velocity-style interface for Org."
- :tag "Org-Velocity"
- :group 'outlines
- :group 'hypermedia)
-
-(defcustom org-velocity-bucket ""
- "Where is the bucket file?"
- :group 'org-velocity
- :type 'file)
-
-(defcustom org-velocity-always-use-bucket nil
- "Use bucket file even when called from an Org buffer?"
- :group 'org-velocity
- :type 'boolean)
-
-(defcustom org-velocity-use-completion nil
- "Complete on heading names?"
- :group 'org-velocity
- :type 'boolean)
-
-(defcustom org-velocity-edit-indirectly t
- "Edit entries in an indirect buffer or just visit the file?"
- :group 'org-velocity
- :type 'boolean)
-
-(defcustom org-velocity-search-method 'phrase
- "Match on whole phrase, any word, or all words?"
- :group 'org-velocity
- :type '(choice
- (const :tag "Match whole phrase" phrase)
- (const :tag "Match any word" any)
- (const :tag "Match all words" all)))
-
-(defcustom org-velocity-create-method 'capture
- "Prefer `org-capture', `org-remember', or neither?"
- :group 'org-velocity
- :type '(choice
- (const :tag "Prefer capture > remember > default." capture)
- (const :tag "Prefer remember > default." remember)
- (const :tag "Edit in buffer." buffer)))
-
-(defcustom org-velocity-allow-regexps nil
- "Allow searches to use regular expressions?"
- :group 'org-velocity
- :type 'boolean)
-
-(defstruct (org-velocity-heading
- (:constructor org-velocity-make-heading)
- (:type list))
- (marker (point-marker))
- (name (substring-no-properties
- (org-get-heading))))
-
-(defconst org-velocity-index
- (eval-when-compile
- (nconc (number-sequence 49 57) ;numbers
- (number-sequence 97 122) ;lowercase letters
- (number-sequence 65 90))) ;uppercase letters
- "List of chars for indexing results.")
-
-(defun org-velocity-use-file ()
- "Return the proper file for Org-Velocity to search.
-If `org-velocity-always-use-bucket' is t, use bucket file; complain
-if missing. Otherwise if this is an Org file, use it."
- (let ((org-velocity-bucket
- (and org-velocity-bucket (expand-file-name org-velocity-bucket))))
- (if org-velocity-always-use-bucket
- (or org-velocity-bucket (error "Bucket required but not defined"))
- (if (and (eq major-mode 'org-mode)
- (buffer-file-name))
- (buffer-file-name)
- (or org-velocity-bucket
- (error "No bucket and not an Org file"))))))
-
-(defsubst org-velocity-display-buffer ()
- "Return the proper buffer for Org-Velocity to display in."
- (get-buffer-create "*Velocity headings*"))
-
-(defsubst org-velocity-bucket-buffer ()
- "Return proper buffer for bucket operations."
- (find-file-noselect (org-velocity-use-file)))
-
-(defun org-velocity-quote (search)
- "Quote SEARCH as a regexp if `org-velocity-allow-regexps' is non-nil.
-Acts like `regexp-quote' on a string, `regexp-opt' on a list."
- (if org-velocity-allow-regexps
- search
- (if (listp search)
- (regexp-opt search)
- (regexp-quote search))))
-
-(defun org-velocity-nearest-heading (position)
- "Return last heading at POSITION.
-If there is no last heading, return nil."
- (save-excursion
- (goto-char position)
- (unless (org-before-first-heading-p)
- (org-back-to-heading)
- (org-velocity-make-heading))))
-
-(defun org-velocity-make-button-action (heading)
- "Return a form to visit HEADING."
- `(lambda (button)
- (run-hooks 'mouse-leave-buffer-hook) ;turn off temporary modes
- (if org-velocity-edit-indirectly
- (org-velocity-edit-entry ',heading)
- (progn
- (message "%s" ,(org-velocity-heading-name heading))
- (switch-to-buffer (marker-buffer
- ,(org-velocity-heading-marker heading)))
- (goto-char (marker-position
- ,(org-velocity-heading-marker heading)))))))
-
-(defun org-velocity-edit-entry (heading)
- "Edit entry at HEADING in an indirect buffer."
- (let ((buffer (make-indirect-buffer
- (marker-buffer (org-velocity-heading-marker heading))
- (generate-new-buffer-name
- (org-velocity-heading-name heading)))))
- (with-current-buffer buffer
- (let ((org-inhibit-startup t))
- (org-mode))
- (goto-char (marker-position (org-velocity-heading-marker heading)))
- (narrow-to-region (point)
- (save-excursion
- (org-end-of-subtree)
- (point)))
- (goto-char (point-min))
- (add-hook 'org-ctrl-c-ctrl-c-hook 'org-velocity-dismiss nil t))
- (pop-to-buffer buffer)
- (set (make-local-variable 'header-line-format)
- (format "%s Use C-c C-c to finish."
- (abbreviate-file-name
- (buffer-file-name
- (marker-buffer
- (org-velocity-heading-marker heading))))))))
-
-(defun org-velocity-dismiss ()
- "Save current entry and close indirect buffer."
- (progn
- (save-buffer)
- (kill-buffer)))
-
-(defun org-velocity-buttonize (heading)
- "Insert HEADING as a text button."
- (insert (format "#%c " (nth (1- (line-number-at-pos))
- org-velocity-index)))
- (let ((action (org-velocity-make-button-action heading)))
- (insert-text-button
- (org-velocity-heading-name heading)
- 'action action))
- (newline))
-
-(defun org-velocity-remember (heading &optional region)
- "Use `org-remember' to record a note to HEADING.
-If there is a REGION that will be inserted."
- (let ((org-remember-templates
- (list (list
- "Velocity entry"
- ?v
- (format "* %s\n\n%%?%s" heading (or region ""))
- (org-velocity-use-file)
- 'bottom))))
- (org-remember nil ?v)))
-
-(defun org-velocity-capture (heading &optional region)
- "Use `org-capture' to record a note to HEADING.
-If there is a REGION that will be inserted."
- (let ((org-capture-templates
- (list `("v"
- "Velocity entry"
- entry
- (file ,(org-velocity-use-file))
- ,(format "* %s\n\n%%?%s" heading (or region ""))))))
- (if (fboundp 'org-capture) ;; quiet compiler
- (org-capture nil "v"))))
-
-(defun org-velocity-insert-heading (heading)
- "Add a new heading named HEADING."
- (with-current-buffer (org-velocity-bucket-buffer)
- (goto-char (point-max))
- (newline)
- (org-insert-heading) (insert heading)
- (newline)
- (goto-char (point-max))))
-
-(defun org-velocity-create-heading (search region)
- "Add and visit a new heading named SEARCH.
-If REGION is non-nil insert as the contents of the heading."
- (org-velocity-insert-heading search)
- (switch-to-buffer (org-velocity-bucket-buffer))
- (when region (insert region)))
-
-(defun org-velocity-all-search (search)
- "Return entries containing all words in SEARCH."
- (when (file-exists-p (org-velocity-use-file))
- (save-excursion
- (delq nil
- (let ((keywords
- (mapcar 'org-velocity-quote
- (split-string search)))
- (case-fold-search t))
- (org-map-entries
- (lambda ()
- (if (loop with limit = (save-excursion
- (org-end-of-subtree)
- (point))
- for word in keywords
- always (save-excursion
- (re-search-forward word limit t)))
- (org-velocity-nearest-heading
- (match-beginning 0))))))))))
-
-(defun org-velocity-generic-search (search)
- "Return entries containing SEARCH."
- (save-excursion
- (delq nil
- (nreverse
- (let (matches (case-fold-search t))
- (goto-char (point-min))
- (while (re-search-forward search
- (point-max) t)
- (push (org-velocity-nearest-heading (match-beginning 0))
- matches)
- (outline-next-heading))
- matches)))))
-
-(defsubst org-velocity-phrase-search (search)
- "Return entries containing SEARCH as a phrase."
- (org-velocity-generic-search (org-velocity-quote search)))
-
-(defsubst org-velocity-any-search (search)
- "Return entries containing any word in SEARCH."
- (org-velocity-generic-search (org-velocity-quote (split-string search))))
-
-(defun org-velocity-present (headings)
- "Buttonize HEADINGS in `org-velocity-display-buffer'."
- (and (listp headings) (delete-dups headings))
- (let ((cdr (nthcdr
- (1- (length org-velocity-index))
- headings)))
- (and (consp cdr) (setcdr cdr nil)))
- (with-current-buffer (org-velocity-display-buffer)
- (mapc
- 'org-velocity-buttonize
- headings)
- (goto-char (point-min))))
-
-(defun org-velocity-create-1 (search region)
- "Create a new heading named SEARCH.
-If REGION is non-nil insert as contents of new heading.
-The possible methods are `org-velocity-capture',
-`org-velocity-remember', or `org-velocity-create-heading', in
-that order. Which is preferred is determined by
-`org-velocity-create-method'."
- (funcall
- (ecase org-velocity-create-method
- (capture (or (and (featurep 'org-capture) 'org-velocity-capture)
- (and (featurep 'org-remember) 'org-velocity-remember)
- 'org-velocity-create-heading))
- (remember (or (and (featurep 'org-remember) 'org-velocity-remember)
- 'org-velocity-create-heading))
- (buffer 'org-velocity-create-heading))
- search region))
-
-(defun org-velocity-create (search &optional ask)
- "Create new heading named SEARCH.
-If ASK is non-nil, ask first."
- (if (or (null ask)
- (y-or-n-p "No match found, create? "))
- ;; if there's a region, we want to insert it
- (let ((region (if (use-region-p)
- (buffer-substring
- (region-beginning)
- (region-end)))))
- (with-current-buffer (org-velocity-bucket-buffer)
- (org-velocity-create-1 search region))
- (when region (message "%s" "Inserted region"))
- search)))
-
-(defun org-velocity-get-matches (search)
- "Return matches for SEARCH in current bucket.
-Use method specified by `org-velocity-search-method'."
- (with-current-buffer (org-velocity-bucket-buffer)
- (case org-velocity-search-method
- ('phrase (org-velocity-phrase-search search))
- ('any (org-velocity-any-search search))
- ('all (org-velocity-all-search search)))))
-
-(defun org-velocity-engine (search)
- "Display a list of headings where SEARCH occurs."
- (with-current-buffer (org-velocity-display-buffer)
- (erase-buffer)
- (setq cursor-type nil))
- (unless (or
- (not (stringp search))
- (string-equal "" search)) ;exit on empty string
- (case
- (with-current-buffer (org-velocity-bucket-buffer)
- (save-excursion
- (let ((matches (org-velocity-get-matches search)))
- (org-velocity-present matches)
- (cond ((zerop (length matches)) 'new)
- ((= (length matches) 1) 'follow)
- ((> (length matches) 1) 'prompt)))))
- ('prompt (progn
- (Electric-pop-up-window (org-velocity-display-buffer))
- (let ((hint (org-velocity-electric-follow-hint)))
- (if hint
- (case hint
- (edit (org-velocity-read nil search))
- (new (org-velocity-create search))
- (otherwise (org-velocity-activate-button hint)))))))
- ('new (unless (org-velocity-create search t)
- (org-velocity-read nil search)))
- ('follow (if (y-or-n-p "One match, follow? ")
- (progn
- (set-buffer (org-velocity-display-buffer))
- (goto-char (point-min))
- (button-activate (next-button (point))))
- (org-velocity-read nil search))))))
-
-(defun org-velocity-position (item list)
- "Return first position of ITEM in LIST."
- (loop for elt in list
- for i from 0
- if (equal elt item)
- return i))
-
-(defun org-velocity-activate-button (char)
- "Go to button on line number associated with CHAR in `org-velocity-index'."
- (goto-char (point-min))
- (forward-line (org-velocity-position char org-velocity-index))
- (goto-char
- (button-start
- (next-button (point))))
- (message "%s" (button-label (button-at (point))))
- (button-activate (button-at (point))))
-
-(defun org-velocity-electric-undefined ()
- "Complain about an undefined key."
- (interactive)
- (message "%s"
- (substitute-command-keys
- "\\[org-velocity-electric-new] for new entry, \\[org-velocity-electric-edit] to edit search, \\[scroll-up] to scroll."))
- (sit-for 4))
-
-(defun org-velocity-electric-follow (ev)
- "Follow a hint indexed by keyboard event EV."
- (interactive (list last-command-event))
- (if (not (> (org-velocity-position ev org-velocity-index)
- (1- (count-lines (point-min) (point-max)))))
- (throw 'org-velocity-select ev)
- (call-interactively 'org-velocity-electric-undefined)))
-
-(defun org-velocity-electric-click (ev)
- "Follow hint indexed by a mouse event EV."
- (interactive "e")
- (throw 'org-velocity-select
- (nth (1- (count-lines
- (point-min)
- (posn-point (event-start ev))))
- org-velocity-index)))
-
-(defun org-velocity-electric-edit ()
- "Edit the search string."
- (interactive)
- (throw 'org-velocity-select 'edit))
-
-(defun org-velocity-electric-new ()
- "Force a new entry."
- (interactive)
- (throw 'org-velocity-select 'new))
-
-(defvar org-velocity-electric-map
- (let ((map (make-sparse-keymap)))
- (define-key map [t] 'org-velocity-electric-undefined) (loop for c in org-velocity-index
- do (define-key map (char-to-string c) 'org-velocity-electric-follow))
- (define-key map "0" 'org-velocity-electric-new)
- (define-key map [tab] 'scroll-up)
- (define-key map [return] 'org-velocity-electric-edit)
- (define-key map [mouse-1] 'org-velocity-electric-click)
- (define-key map [mouse-2] 'org-velocity-electric-click)
- (define-key map [escape escape escape] 'keyboard-quit)
- (define-key map "\C-h" 'help-command)
- map))
-
-(defun org-velocity-electric-follow-hint ()
- "Read index of button electrically."
- (with-current-buffer (org-velocity-display-buffer)
- (use-local-map org-velocity-electric-map)
- (catch 'org-velocity-select
- (Electric-command-loop 'org-velocity-select
- "Follow: "))))
-
-(defun org-velocity-read-with-completion (prompt)
- "Like `completing-read' on entries with PROMPT.
-Use `minibuffer-local-filename-completion-map'."
- (let ((minibuffer-local-completion-map
- minibuffer-local-filename-completion-map))
- (completing-read
- prompt
- (mapcar 'substring-no-properties
- (org-map-entries 'org-get-heading)))))
-
-(defun org-velocity-read-string (prompt &optional initial-input)
- "Read string with PROMPT followed by INITIAL-INPUT."
- ;; The use of initial inputs to the minibuffer is deprecated (see
- ;; `read-from-minibuffer'), but in this case it is the user-friendly
- ;; thing to do.
- (minibuffer-with-setup-hook
- (lexical-let ((initial-input initial-input))
- (lambda ()
- (and initial-input (insert initial-input))
- (goto-char (point-max))))
- (if (and org-velocity-use-completion
- ;; map-entries complains for nonexistent files
- (file-exists-p (org-velocity-use-file)))
- (org-velocity-read-with-completion prompt)
- (read-string prompt))))
-
-(defun org-velocity-read (arg &optional search)
- "Read a search string SEARCH for Org-Velocity interface.
-This means that a buffer will display all headings where SEARCH
-occurs, where one can be selected by a mouse click or by typing
-its index. If SEARCH does not occur, then a new heading may be
-created named SEARCH.
-
-If `org-velocity-bucket' is defined and
-`org-velocity-always-use-bucket' is non-nil, then the bucket file
-will be used; otherwise, this will work when called in any Org
-file. Calling with ARG forces current file."
- (interactive "P")
- (let ((org-velocity-always-use-bucket
- (if arg nil org-velocity-always-use-bucket)))
- ;; complain if inappropriate
- (assert (org-velocity-use-file))
- (unwind-protect
- (org-velocity-engine
- (org-velocity-read-string "Velocity search: " search))
- (progn
- (kill-buffer (org-velocity-display-buffer))
- (delete-other-windows)))))
-
-(provide 'org-velocity)
-;;; org-velocity.el ends here
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-wikinodes.el b/.emacs.d/org-7.4/contrib/lisp/org-wikinodes.el
deleted file mode 100644
index 85c32f6..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-wikinodes.el
+++ /dev/null
@@ -1,339 +0,0 @@
-;;; org-wikinodes.el --- Wiki-like CamelCase links to outline nodes
-
-;; Copyright (C) 2010 Free Software Foundation, Inc.
-
-;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: http://orgmode.org
-;; Version: 7.01trans
-;;
-;; This file is 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/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(require 'org)
-(eval-when-compile
- (require 'cl))
-
-(defgroup org-wikinodes nil
- "Wiki-like CamelCase links words to outline nodes in Org mode."
- :tag "Org WikiNodes"
- :group 'org)
-
-(defconst org-wikinodes-camel-regexp "\\<[A-Z]+[a-z]+[A-Z]+[a-z]+[a-zA-Z]*\\>"
- "Regular expression matching CamelCase words.")
-
-(defcustom org-wikinodes-active t
- "Should CamelCase links be active in the current file?"
- :group 'org-wikinodes
- :type 'boolean)
-(put 'org-wikinodes-active 'safe-local-variable 'booleanp)
-
-(defcustom org-wikinodes-scope 'file
- "The scope of searches for wiki targets.
-Allowed values are:
-
-file Search for targets in the current file only
-directory Search for targets in all org files in the current directory"
- :group 'org-wikinodes
- :type '(choice
- (const :tag "Find targets in current file" file)
- (const :tag "Find targets in current directory" directory)))
-
-(defcustom org-wikinodes-create-targets 'query
- "Non-nil means create Wiki target when following a wiki link fails.
-Allowed values are:
-
-nil never create node, just throw an error if the target does not exist
-query ask the user what to do
-t create the node in the current buffer
-\"file.org\" create the node in the file \"file.org\", in the same directory
-
-If you are using wiki links across files, you need to set `org-wikinodes-scope'
-to `directory'."
- :group 'org-wikinodes
- :type '(choice
- (const :tag "Never automatically create node" nil)
- (const :tag "In current file" t)
- (file :tag "In one special file\n")
- (const :tag "Query the user" query)))
-
-;;; Link activation
-
-(defun org-wikinodes-activate-links (limit)
- "Activate CamelCase words as links to Wiki targets."
- (when org-wikinodes-active
- (let (case-fold-search)
- (if (re-search-forward org-wikinodes-camel-regexp limit t)
- (if (equal (char-after (point-at-bol)) ?*)
- (progn
- ;; in heading - deactivate flyspell
- (org-remove-flyspell-overlays-in (match-beginning 0)
- (match-end 0))
- (add-text-properties (match-beginning 0) (match-end 0)
- '(org-no-flyspell t))
- t)
- ;; this is a wiki link
- (org-remove-flyspell-overlays-in (match-beginning 0)
- (match-end 0))
- (add-text-properties (match-beginning 0) (match-end 0)
- (list 'mouse-face 'highlight
- 'face 'org-link
- 'keymap org-mouse-map
- 'help-echo "Wiki Link"))
- t)))))
-
-;;; Following links and creating non-existing target nodes
-
-(defun org-wikinodes-open-at-point ()
- "Check if the cursor is on a Wiki link and follow the link.
-
-This function goes into `org-open-at-point-functions'."
- (and org-wikinodes-active
- (not (org-on-heading-p))
- (let (case-fold-search) (org-in-regexp org-wikinodes-camel-regexp))
- (progn (org-wikinodes-follow-link (match-string 0)) t)))
-
-(defun org-wikinodes-follow-link (target)
- "Follow a wiki link to TARGET.
-
-This need to be found as an exact headline match, either in the current
-buffer, or in any .org file in the current directory, depending on the
-variable `org-wikinodes-scope'.
-
-If a target headline is not found, it may be created according to the
-setting of `org-wikinodes-create-targets'."
- (if current-prefix-arg (org-wikinodes-clear-direcory-targets-cache))
- (let ((create org-wikinodes-create-targets)
- visiting buffer m pos file rpl)
- (setq pos
- (or (org-find-exact-headline-in-buffer target (current-buffer))
- (and (eq org-wikinodes-scope 'directory)
- (setq file (org-wikinodes-which-file target))
- (org-find-exact-headline-in-buffer
- target (or (get-file-buffer file)
- (find-file-noselect file))))))
- (if pos
- (progn
- (org-mark-ring-push (point))
- (org-goto-marker-or-bmk pos)
- (move-marker pos nil))
- (when (eq create 'query)
- (if (eq org-wikinodes-scope 'directory)
- (progn
- (message "Node \"%s\" does not exist. Should it be created?
-\[RET] in this buffer [TAB] in another file [q]uit" target)
- (setq rpl (read-char-exclusive))
- (cond
- ((member rpl '(?\C-g ?q)) (error "Abort"))
- ((equal rpl ?\C-m) (setq create t))
- ((equal rpl ?\C-i)
- (setq create (file-name-nondirectory
- (read-file-name "Create in file: "))))
- (t (error "Invalid selection"))))
- (if (y-or-n-p (format "Create new node \"%s\" in current buffer? "
- target))
- (setq create t)
- (error "Abort"))))
-
- (cond
- ((not create)
- ;; We are not allowed to create the new node
- (error "No match for link to \"%s\"" target))
- ((stringp create)
- ;; Make new node in another file
- (org-mark-ring-push (point))
- (switch-to-buffer (find-file-noselect create))
- (goto-char (point-max))
- (or (bolp) (newline))
- (insert "\n* " target "\n")
- (backward-char 1)
- (org-wikinodes-add-target-to-cache target)
- (message "New Wiki target `%s' created in file \"%s\""
- target create))
- (t
- ;; Make new node in current buffer
- (org-mark-ring-push (point))
- (goto-char (point-max))
- (or (bolp) (newline))
- (insert "* " target "\n")
- (backward-char 1)
- (org-wikinodes-add-target-to-cache target)
- (message "New Wiki target `%s' created in current buffer"
- target))))))
-
-;;; The target cache
-
-(defvar org-wikinodes-directory-targets-cache nil)
-
-(defun org-wikinodes-clear-cache-when-on-target ()
- "When on a headline that is a Wiki target, clear the cache."
- (when (and (org-on-heading-p)
- (org-in-regexp (format org-complex-heading-regexp-format
- org-wikinodes-camel-regexp))
- (org-in-regexp org-wikinodes-camel-regexp))
- (org-wikinodes-clear-direcory-targets-cache)
- t))
-
-(defun org-wikinodes-clear-direcory-targets-cache ()
- "Clear the cache where to find wiki targets."
- (interactive)
- (setq org-wikinodes-directory-targets-cache nil)
- (message "Wiki target cache cleared, so that it will update when used again"))
-
-(defun org-wikinodes-get-targets ()
- "Return a list of all wiki targets in the current buffer."
- (let ((re (format org-complex-heading-regexp-format
- org-wikinodes-camel-regexp))
- (case-fold-search nil)
- targets)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (while (re-search-forward re nil t)
- (push (org-match-string-no-properties 4) targets))))
- (nreverse targets)))
-
-(defun org-wikinodes-get-links-for-directory (dir)
- "Return an alist that connects wiki links to files in directory DIR."
- (let ((files (directory-files dir nil "\\`[^.#].*\\.org\\'"))
- (org-inhibit-startup t)
- target-file-alist file visiting m buffer)
- (while (setq file (pop files))
- (setq visiting (org-find-base-buffer-visiting file))
- (setq buffer (or visiting (find-file-noselect file)))
- (with-current-buffer buffer
- (mapc
- (lambda (target)
- (setq target-file-alist (cons (cons target file) target-file-alist)))
- (org-wikinodes-get-targets)))
- (or visiting (kill-buffer buffer)))
- target-file-alist))
-
-(defun org-wikinodes-add-target-to-cache (target &optional file)
- (setq file (or file buffer-file-name (error "No file for new wiki target")))
- (set-text-properties 0 (length target) nil target)
- (let ((dir (file-name-directory (expand-file-name file)))
- a)
- (setq a (assoc dir org-wikinodes-directory-targets-cache))
- (if a
- ;; Push the new target onto the existing list
- (push (cons target (expand-file-name file)) (cdr a))
- ;; Call org-wikinodes-which-file so that the cache will be filled
- (org-wikinodes-which-file target dir))))
-
-(defun org-wikinodes-which-file (target &optional directory)
- "Return the file for wiki headline TARGET DIRECTORY.
-If there is no such wiki target, return nil."
- (setq directory (expand-file-name (or directory default-directory)))
- (unless (assoc directory org-wikinodes-directory-targets-cache)
- (push (cons directory (org-wikinodes-get-links-for-directory directory))
- org-wikinodes-directory-targets-cache))
- (cdr (assoc target (cdr (assoc directory
- org-wikinodes-directory-targets-cache)))))
-
-;;; Exporting Wiki links
-
-(defvar target)
-(defvar target-alist)
-(defvar last-section-target)
-(defvar org-export-target-aliases)
-(defun org-wikinodes-set-wiki-targets-during-export ()
- (let ((line (buffer-substring (point-at-bol) (point-at-eol)))
- (case-fold-search nil)
- wtarget a)
- (when (string-match (format org-complex-heading-regexp-format
- org-wikinodes-camel-regexp)
- line)
- (setq wtarget (match-string 4 line))
- (push (cons wtarget target) target-alist)
- (setq a (or (assoc last-section-target org-export-target-aliases)
- (progn
- (push (list last-section-target)
- org-export-target-aliases)
- (car org-export-target-aliases))))
- (push (caar target-alist) (cdr a)))))
-
-(defvar org-current-export-file)
-(defun org-wikinodes-process-links-for-export ()
- "Process Wiki links in the export preprocess buffer.
-
-Try to find target matches in the wiki scope and replace CamelCase words
-with working links."
- (let ((re org-wikinodes-camel-regexp)
- (case-fold-search nil)
- link file)
- (goto-char (point-min))
- (while (re-search-forward re nil t)
- (org-if-unprotected-at (match-beginning 0)
- (unless (save-match-data
- (or (org-on-heading-p)
- (org-in-regexp org-bracket-link-regexp)
- (org-in-regexp org-plain-link-re)
- (org-in-regexp "<<[^<>]+>>")))
- (setq link (match-string 0))
- (delete-region (match-beginning 0) (match-end 0))
- (save-match-data
- (cond
- ((org-find-exact-headline-in-buffer link (current-buffer))
- ;; Found in current buffer
- (insert (format "[[#%s][%s]]" link link)))
- ((eq org-wikinodes-scope 'file)
- ;; No match in file, and other files are not allowed
- (insert (format "%s" link)))
- ((setq file
- (and (org-string-nw-p org-current-export-file)
- (org-wikinodes-which-file
- link (file-name-directory org-current-export-file))))
- ;; Match in another file in the current directory
- (insert (format "[[file:%s::%s][%s]]" file link link)))
- (t ;; No match for this link
- (insert (format "%s" link))))))))))
-
-;;; Hook the WikiNode mechanism into Org
-
-;; `C-c C-o' should follow wiki links
-(add-hook 'org-open-at-point-functions 'org-wikinodes-open-at-point)
-
-;; `C-c C-c' should clear the cache
-(add-hook 'org-ctrl-c-ctrl-c-hook 'org-wikinodes-clear-cache-when-on-target)
-
-;; Make Wiki haeding create additional link names for headlines
-(add-hook 'org-export-define-heading-targets-headline-hook
- 'org-wikinodes-set-wiki-targets-during-export)
-
-;; Turn Wiki links into links the exporter will treat correctly
-(add-hook 'org-export-preprocess-after-radio-targets-hook
- 'org-wikinodes-process-links-for-export)
-
-;; Activate CamelCase words as part of Org mode font lock
-
-(defun org-wikinodes-add-to-font-lock-keywords ()
- "Add wikinode CamelCase highlighting to `org-font-lock-extra-keywords'."
- (let ((m (member '(org-activate-plain-links) org-font-lock-extra-keywords)))
- (if m
- (setcdr m (cons '(org-wikinodes-activate-links) (cdr m)))
- (message
- "Failed to add wikinodes to `org-font-lock-extra-keywords'."))))
-
-(add-hook 'org-font-lock-set-keywords-hook
- 'org-wikinodes-add-to-font-lock-keywords)
-
-(provide 'org-wikinodes)
-
-;; arch-tag: e3b56e38-a2be-478c-b56c-68a913ec54ec
-
-;;; org-wikinodes.el ends here
diff --git a/.emacs.d/org-7.4/contrib/lisp/org2rem.el b/.emacs.d/org-7.4/contrib/lisp/org2rem.el
deleted file mode 100644
index 5d160dc..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org2rem.el
+++ /dev/null
@@ -1,653 +0,0 @@
-;;; org2rem.el --- Convert org appointments into reminders
-
-;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Bastien Guerry and Shatad Pratap
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: http://orgmode.org
-;; Version: 6.09a
-;;
-;; 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:
-
-;; (require 'org2rem)
-;; To export, do
-;;
-;; M-x org2rem-combine-agenda-files
-;;
-;; Then you can use reming like this:
-;;
-;; $ remind ~/org.rem
-;;
-;; If you want to use this regualrly, try in .emacs
-;;
-;; (add-hook 'org-mode-hook
-;; (lambda() (add-hook 'after-save-hook
-;; 'org-export-remind-all-agenda-files t t)))
-
-(require 'org)
-(require 'org-agenda)
-(require 'org-exp)
-(eval-and-compile
- (require 'cl))
-
-(defgroup org2rem nil
- "Options specific for Remind export of Org-mode files."
- :tag "Org Export Remind"
- :group 'org-export)
-
-(defcustom org-combined-agenda-remind-file "~/org.rem"
- "The file name for the Remind file covering all agenda files.
-This file is created with the command \\[org2rem-all-agenda-files].
-The file name should be absolute, the file will be overwritten without warning."
- :group 'org2rem
- :type 'file)
-
-(defcustom org-remind-combined-name "OrgMode"
- "Calendar name for the combined Remind representing all agenda files."
- :group 'org2rem
- :type 'string)
-
-(defcustom org-remind-use-deadline '(event-if-not-todo todo-due)
- "Contexts where Remind export should use a deadline time stamp.
-This is a list with several symbols in it. Valid symbol are:
-
-event-if-todo Deadlines in TODO entries become calendar events.
-event-if-not-todo Deadlines in non-TODO entries become calendar events.
-todo-due Use deadlines in TODO entries as due-dates"
- :group 'org2rem
- :type '(set :greedy t
- (const :tag "Deadlines in non-TODO entries become events"
- event-if-not-todo)
- (const :tag "Deadline in TODO entries become events"
- event-if-todo)
- (const :tag "Deadlines in TODO entries become due-dates"
- todo-due)))
-
-(defcustom org-remind-use-scheduled '(todo-start)
- "Contexts where Remind export should use a scheduling time stamp.
-This is a list with several symbols in it. Valid symbol are:
-
-event-if-todo Scheduling time stamps in TODO entries become an event.
-event-if-not-todo Scheduling time stamps in non-TODO entries become an event.
-todo-start Scheduling time stamps in TODO entries become start date.
- Some calendar applications show TODO entries only after
- that date."
- :group 'org2rem
- :type '(set :greedy t
- (const :tag
- "SCHEDULED timestamps in non-TODO entries become events"
- event-if-not-todo)
- (const :tag "SCHEDULED timestamps in TODO entries become events"
- event-if-todo)
- (const :tag "SCHEDULED in TODO entries become start date"
- todo-start)))
-
-(defcustom org-remind-categories '(local-tags category)
- "Items that should be entered into the categories field.
-This is a list of symbols, the following are valid:
-
-category The Org-mode category of the current file or tree
-todo-state The todo state, if any
-local-tags The tags, defined in the current line
-all-tags All tags, including inherited ones."
- :group 'org2rem
- :type '(repeat
- (choice
- (const :tag "The file or tree category" category)
- (const :tag "The TODO state" todo-state)
- (const :tag "Tags defined in current line" local-tags)
- (const :tag "All tags, including inherited ones" all-tags))))
-
-(defcustom org-remind-include-todo nil
- "Non-nil means export to remind files should also cover TODO items."
- :group 'org2rem
- :type '(choice
- (const :tag "None" nil)
- (const :tag "Unfinished" t)
- (const :tag "All" all)))
-
-(defcustom org-remind-include-sexps t
- "Non-nil means export to Remind files should also cover sexp entries.
-These are entries like in the diary, but directly in an Org-mode file."
- :group 'org2rem
- :type 'boolean)
-
-(defcustom org-remind-deadline-over-scheduled t
- "Non-nil means use deadline as target when both deadline and
-scheduled present, vice-versa. Default is Non-nil."
- :group 'org2rem
- :type 'boolean)
-
-(defcustom org-remind-escape-percentage t
- "Non-nil means % will be escaped, vice-versa. Default is Non-nil."
- :group 'org2rem
- :type 'boolean)
-
-(defcustom org-remind-extra-warn-days 3
- "Extra days Remind keep reminding."
- :group 'org2rem
- :type 'number)
-
-(defcustom org-remind-advanced-warn-days 3
- "Advanced days Remind start reminding."
- :group 'org2rem
- :type 'number)
-
-(defcustom org-remind-suppress-last-newline nil
- "Non-nil means suppress last newline REM body. Default is nil."
- :group 'org2rem
- :type 'boolean)
-
-(defcustom org-remind-include-body 100
- "Amount of text below headline to be included in Remind export.
-This is a number of characters that should maximally be included.
-Properties, scheduling and clocking lines will always be removed.
-The text will be inserted into the DESCRIPTION field."
- :group 'org2rem
- :type '(choice
- (const :tag "Nothing" nil)
- (const :tag "Everything" t)
- (integer :tag "Max characters")))
-
-(defcustom org-remind-store-UID nil
- "Non-nil means store any created UIDs in properties.
-The Remind standard requires that all entries have a unique identifyer.
-Org will create these identifiers as needed. When this variable is non-nil,
-the created UIDs will be stored in the ID property of the entry. Then the
-next time this entry is exported, it will be exported with the same UID,
-superceeding the previous form of it. This is essential for
-synchronization services.
-This variable is not turned on by default because we want to avoid creating
-a property drawer in every entry if people are only playing with this feature,
-or if they are only using it locally."
- :group 'org2rem
- :type 'boolean)
-
-;;;; Exporting
-
-;;; Remind export
-
-;;;###autoload
-(defun org2rem-this-file ()
- "Export current file as an Remind file.
-The Remind file will be located in the same directory as the Org-mode
-file, but with extension `.rem'."
- (interactive)
- (org2rem nil buffer-file-name))
-
-;;;###autoload
-(defun org2rem-all-agenda-files ()
- "Export all files in `org-agenda-files' to Remind .rem files.
-Each Remind file will be located in the same directory as the Org-mode
-file, but with extension `.rem'."
- (interactive)
- (apply 'org2rem nil (org-agenda-files t)))
-
-;;;###autoload
-(defun org2rem-combine-agenda-files ()
- "Export all files in `org-agenda-files' to a single combined Remind file.
-The file is stored under the name `org-combined-agenda-remind-file'."
- (interactive)
- (apply 'org2rem t (org-agenda-files t)))
-
-(defun org2rem (combine &rest files)
- "Create Remind files for all elements of FILES.
-If COMBINE is non-nil, combine all calendar entries into a single large
-file and store it under the name `org-combined-agenda-remind-file'."
- (save-excursion
- (org-prepare-agenda-buffers files)
- (let* ((dir (org-export-directory
- :ical (list :publishing-directory
- org-export-publishing-directory)))
- file rem-file rem-buffer category started org-agenda-new-buffers)
- (and (get-buffer "*rem-tmp*") (kill-buffer "*rem-tmp*"))
- (when combine
- (setq rem-file
- (if (file-name-absolute-p org-combined-agenda-remind-file)
- org-combined-agenda-remind-file
- (expand-file-name org-combined-agenda-remind-file dir))
- rem-buffer (org-get-agenda-file-buffer rem-file))
- (set-buffer rem-buffer) (erase-buffer))
- (while (setq file (pop files))
- (catch 'nextfile
- (org-check-agenda-file file)
- (set-buffer (org-get-agenda-file-buffer file))
- (unless combine
- (setq rem-file (concat (file-name-as-directory dir)
- (file-name-sans-extension
- (file-name-nondirectory buffer-file-name))
- ".rem"))
- (setq rem-buffer (org-get-agenda-file-buffer rem-file))
- (with-current-buffer rem-buffer (erase-buffer)))
- (setq category (or org-category
- (file-name-sans-extension
- (file-name-nondirectory buffer-file-name))))
- (if (symbolp category) (setq category (symbol-name category)))
- (let ((standard-output rem-buffer))
- (if combine
- (and (not started) (setq started t)
- (org-start-remind-file org-remind-combined-name))
- (org-start-remind-file category))
- (org-print-remind-entries combine)
- (when (or (and combine (not files)) (not combine))
- (org-finish-remind-file)
- (set-buffer rem-buffer)
- (run-hooks 'org-before-save-Remind-file-hook)
- (save-buffer)
- (run-hooks 'org-after-save-Remind-file-hook)
- (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))
- ))))
- (org-release-buffers org-agenda-new-buffers))))
-
-(defvar org-before-save-Remind-file-hook nil
- "Hook run before an Remind file has been saved.
-This can be used to modify the result of the export.")
-
-(defvar org-after-save-Remind-file-hook nil
- "Hook run after an Remind file has been saved.
-The Remind buffer is still current when this hook is run.
-A good way to use this is to tell a desktop calenndar application to re-read
-the Remind file.")
-
-(defvar org-agenda-default-appointment-duration) ; defined in org-agenda.el
-(defun org-print-remind-entries (&optional combine)
- "Print Remind entries for the current Org-mode file to `standard-output'.
-When COMBINE is non nil, add the category to each line."
- (require 'org-agenda)
- (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>"))
- (re2 (concat "--?-?\\(" org-ts-regexp "\\)"))
- (dts (org-rem-ts-to-string
- (format-time-string (cdr org-time-stamp-formats) (current-time))
- "start time:"))
- hd ts ts2 state status (inc t) pos b sexp rrule
- scheduledp deadlinep todo prefix due start
- tmp pri categories entry location summary desc uid
- remind-aw remind-ew (org-rem-ew org-remind-extra-warn-days)
- (org-rem-aw org-remind-advanced-warn-days)
- trigger diff-days (dos org-remind-deadline-over-scheduled)
- (suppress-last-newline org-remind-suppress-last-newline)
- (sexp-buffer (get-buffer-create "*rem-tmp*")))
- (org-refresh-category-properties)
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward re1 nil t)
- (catch :skip
- (org-agenda-skip)
- (when (boundp 'org-remind-verify-function)
- (unless (funcall org-remind-verify-function)
- (outline-next-heading)
- (backward-char 1)
- (throw :skip nil)))
- (setq pos (match-beginning 0)
- ts (match-string 0)
- inc t
- hd (condition-case nil
- (org-remind-cleanup-string
- (org-get-heading))
- (error (throw :skip nil)))
- summary (org-remind-cleanup-string
- (org-entry-get nil "SUMMARY"))
- desc (org-remind-cleanup-string
- (or (org-entry-get nil "DESCRIPTION")
- (and org-remind-include-body (org-get-entry)))
- t org-remind-include-body)
- location (org-remind-cleanup-string
- (org-entry-get nil "LOCATION"))
- uid (if org-remind-store-UID
- (org-id-get-create)
- (or (org-id-get) (org-id-new)))
- categories (org-export-get-remind-categories)
- deadlinep nil scheduledp nil)
- (if (looking-at re2)
- (progn
- (goto-char (match-end 0))
- (setq ts2 (match-string 1)
- inc (not (string-match "[0-9]\\{1,2\\}:[0-9][0-9]" ts2))))
- (setq tmp (buffer-substring (max (point-min)
- (- pos org-ds-keyword-length))
- pos)
- ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts)
- (progn
- (setq inc nil)
- (replace-match "\\1" t nil ts))
- ts)
- deadlinep (string-match org-deadline-regexp tmp)
- scheduledp (string-match org-scheduled-regexp tmp)
- todo (org-get-todo-state)
- ;; donep (org-entry-is-done-p)
- ))
- (when (and
- deadlinep
- (if todo
- (not (memq 'event-if-todo org-remind-use-deadline))
- (not (memq 'event-if-not-todo org-remind-use-deadline))))
- (throw :skip t))
- (when (and
- scheduledp
- (if todo
- (not (memq 'event-if-todo org-remind-use-scheduled))
- (not (memq 'event-if-not-todo org-remind-use-scheduled))))
- (throw :skip t))
- (setq prefix (if deadlinep "DEADLINE-" (if scheduledp "SCHEDULED-" "TS-")))
- (if (or (string-match org-tr-regexp hd)
- (string-match org-ts-regexp hd))
- (setq hd (replace-match "" t t hd)))
- (if (string-match "\\+\\([0-9]+\\)\\([dwmy]\\)>" ts)
- (setq rrule ;is recurrence value. later give it good name.
- (* (string-to-number
- (cdr (assoc
- (match-string 2 ts)
- '(("d" . "1")("w" . "7")
- ("m" . "0")("y" . "0")))))
- (string-to-number (match-string 1 ts))))
- (setq rrule nil))
- (setq summary (or summary hd))
- (if (string-match org-bracket-link-regexp summary)
- (setq summary
- (replace-match (if (match-end 3)
- (match-string 3 summary)
- (match-string 1 summary))
- t t summary)))
- (if deadlinep (setq summary (concat "DEADLINE: " summary)))
- (if scheduledp (setq summary (concat "SCHEDULED: " summary)))
- (if (string-match "\\`<%%" ts)
- (with-current-buffer sexp-buffer
- (insert (substring ts 1 -1) " " summary "\n"))
- (princ (format "\n## BEGIN:EVENT
-## UID: %s
-REM %s %s MSG EVENT:%s%s %s%s%%
-## CATEGORIES:%s
-## END:EVENT\n"
- (concat prefix uid)
- (org-rem-ts-to-string ts nil nil rrule)
- (org-rem-ts-to-string ts2 "UNTIL " inc)
- summary
- (if (and desc (string-match "\\S-" desc))
- (concat "%_\\\n" desc) "")
- (if (and location (string-match "\\S-" location))
- (concat "\nLOCATION: " location) "")
- (if suppress-last-newline "" "%_")
- categories)))))
-
- (when (and org-remind-include-sexps
- (condition-case nil (require 'remind) (error nil))
- (fboundp 'remind-export-region))
- ;; Get all the literal sexps
- (goto-char (point-min))
- (while (re-search-forward "^&?%%(" nil t)
- (catch :skip
- (org-agenda-skip)
- (setq b (match-beginning 0))
- (goto-char (1- (match-end 0)))
- (forward-sexp 1)
- (end-of-line 1)
- (setq sexp (buffer-substring b (point)))
- (with-current-buffer sexp-buffer
- (insert sexp "\n"))))
- ;; (princ (org-diary-to-rem-string sexp-buffer))
- (kill-buffer sexp-buffer))
-
- (when org-remind-include-todo
- (setq prefix "TODO-")
- (goto-char (point-min))
- (while (re-search-forward org-todo-line-regexp nil t)
- (catch :skip
- (org-agenda-skip)
- (when (boundp 'org-remind-verify-function)
- (unless (funcall org-remind-verify-function)
- (outline-next-heading)
- (backward-char 1)
- (throw :skip nil)))
- (setq state (match-string 2))
- (setq status (if (member state org-done-keywords)
- "COMPLETED" "NEEDS-ACTION"))
- (when (and state
- (or (not (member state org-done-keywords))
- (eq org-remind-include-todo 'all))
- (not (member org-archive-tag (org-get-tags-at)))
- )
- (setq hd (match-string 3)
- summary (org-remind-cleanup-string
- (org-entry-get nil "SUMMARY"))
- desc (org-remind-cleanup-string
- (or (org-entry-get nil "DESCRIPTION")
- (and org-remind-include-body (org-get-entry)))
- t org-remind-include-body)
- location (org-remind-cleanup-string
- (org-entry-get nil "LOCATION"))
- due (and (member 'todo-due org-remind-use-deadline)
- (org-entry-get nil "DEADLINE"))
- start (and (member 'todo-start org-remind-use-scheduled)
- (org-entry-get nil "SCHEDULED"))
- categories (org-export-get-remind-categories)
- uid (if org-remind-store-UID
- (org-id-get-create)
- (or (org-id-get) (org-id-new))))
-
- (if (and due start)
- (setq diff-days (org-rem-time-diff-days due start)))
-
- (setq remind-aw
- (if due
- (if diff-days
- (if (> diff-days 0)
- (if dos diff-days 0)
- (if dos 0 diff-days))
- 1000)))
-
- (if (and (numberp org-rem-aw) (> org-rem-aw 0))
- (setq remind-aw (+ (or remind-aw 0) org-rem-aw)))
-
- (setq remind-ew
- (if due
- (if diff-days
- (if (> diff-days 0) due nil)
- due)))
-
- (setq trigger (if dos (if due due start) (if start start due)))
- ;; (and trigger (setq trigger (org-rem-ts-to-string trigger nil nil 1 remind-aw)))
- (if trigger
- (setq trigger (concat
- (format "[trigger('%s')] *%d "
- (org-rem-ts-to-remind-date-type trigger) 1)
- (if remind-aw (format "++%d" remind-aw)))))
- (and due (setq due (org-rem-ts-to-remind-date-type due)))
- (and start (setq start (org-rem-ts-to-remind-date-type start)))
- (and remind-ew (setq remind-ew (org-rem-ts-to-remind-date-type remind-ew)))
-
- (if (string-match org-bracket-link-regexp hd)
- (setq hd (replace-match (if (match-end 3) (match-string 3 hd)
- (match-string 1 hd))
- t t hd)))
- (if (string-match org-priority-regexp hd)
- (setq pri (string-to-char (match-string 2 hd))
- hd (concat (substring hd 0 (match-beginning 1))
- (substring hd (match-end 1))))
- (setq pri org-default-priority))
- (setq pri (floor (1+ (* 8. (/ (float (- org-lowest-priority pri))
- (- org-lowest-priority org-highest-priority))))))
-
- (princ (format "\n## BEGIN:TODO
-## UID: %s
-REM %s %s %s MSG TODO: %s%s%s%s%s%s%%
-## CATEGORIES:%s
-## SEQUENCE:1
-## STATUS:%s
-## END:TODO\n"
- (concat prefix uid)
- (or trigger "") ;; dts)
- (if remind-ew (format "UNTIL [trigger('%s' + %d)]" remind-ew (or org-rem-ew 0)) "")
- (if pri (format "PRIORITY %d" pri) "")
- (or summary hd)
- (if (and desc (string-match "\\S-" desc))
- (concat "%_\\\nDESCRIPTION: " desc) "")
- (if (and location (string-match "\\S-" location))
- (concat "LOCATION: " location) "")
- (if start
- (concat
- "%_\\\n['" start "' - today()] "
- "days over, for scheduled date - "
- "[trigger('" start "')]") "")
- (if due
- (concat
- "%_\\\n[today() - '" due "'] "
- "days left, to deadline date - "
- "[trigger('" due "')]") "")
- (if suppress-last-newline "" "%_")
- categories
- status)))))))))
-
-(defun org-export-get-remind-categories ()
- "Get categories according to `org-remind-categories'."
- (let ((cs org-remind-categories) c rtn tmp)
- (while (setq c (pop cs))
- (cond
- ((eq c 'category) (push (org-get-category) rtn))
- ((eq c 'todo-state)
- (setq tmp (org-get-todo-state))
- (and tmp (push tmp rtn)))
- ((eq c 'local-tags)
- (setq rtn (append (nreverse (org-get-local-tags-at (point))) rtn)))
- ((eq c 'all-tags)
- (setq rtn (append (nreverse (org-get-tags-at (point))) rtn)))))
- (mapconcat 'identity (nreverse rtn) ",")))
-
-(defun org-remind-cleanup-string (s &optional is-body maxlength)
- "Take out stuff and quote what needs to be quoted.
-When IS-BODY is non-nil, assume that this is the body of an item, clean up
-whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH
-characters."
- (if (or (not s) (string-match "^[ \t\n]*$" s))
- nil
- (when is-body
- (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
- (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
- (while (string-match re s) (setq s (replace-match "" t t s)))
- (while (string-match re2 s) (setq s (replace-match "" t t s)))))
- (if org-remind-escape-percentage
- (let ((start 0))
- (while (string-match "\\([%]\\)" s start)
- (setq start (+ (match-beginning 0) 2)
- s (replace-match "\\1\\1" nil nil s)))))
-
- (let ((start 0))
- (while (string-match "\\([\n]\\)" s start)
- (setq start (+ (match-beginning 0) 4) ;; less than 4 is not correct.
- s (replace-match "%_\\\\\\1" nil nil s))))
-
- (let ((start 0))
- (while (string-match "\\([[]\\)" s start)
- (setq start (+ (match-beginning 0) 5)
- s (replace-match (concat "\[" "\"" "\\1" "\"" "\]") nil nil s))))
-
-;;; (when is-body
-;;; (while (string-match "[ \t]*\n[ \t]*" s)
-;;; (setq s (replace-match "%_" t t s))))
-
- (setq s (org-trim s))
- (if is-body
- (if maxlength
- (if (and (numberp maxlength)
- (> (length s) maxlength))
- (setq s (substring s 0 maxlength)))))
- s))
-
-(defun org-get-entry ()
- "Clean-up description string."
- (save-excursion
- (org-back-to-heading t)
- (buffer-substring (point-at-bol 2) (org-end-of-subtree t))))
-
-(defun org-start-remind-file (name)
- "Start an Remind file by inserting the header."
- (let ((user user-full-name)
- (name (or name "unknown"))
- (timezone (cadr (current-time-zone))))
- (princ
- (format "# -*- Mode: shell-script; auto-fill-mode: nil -*-
-## BEGIN: Reminders
-## VERSION:2.0
-## Emacs with Org-mode
-## Calendar:%s
-## Created by: %s
-## Timezone:%s
-## Calscale:Gregorian\n" name user timezone))))
-
-(defun org-finish-remind-file ()
- "Finish an Remind file by inserting the END statement."
- (princ "\n## END:Reminders\n"))
-
-(defun org-rem-ts-to-remind-date-type (s)
- (format-time-string
- "%Y-%m-%d"
- (apply 'encode-time (butlast (org-parse-time-string s) 3))))
-
-;; (defun org-rem-date-type-to-string (s keyword &optional inc day-repeat day-advance-warn)
-;; (if trigger
-;; (setq trigger
-;; (concat
-;; (format "[trigger('%s')] *%d "
-;; (org-rem-ts-to-remind-date-type trigger) day-repeat)
-;; (if day-advance-warn (format "++%d" day-advance-warn))))))
-
-;; (format-time-string "%Y"
-;; (apply 'encode-time (butlast (org-parse-time-string "<2008-11-20 Thu 10:30>") 3)))
-
-(defun org-rem-ts-to-string (s keyword &optional inc day-repeat day-advance-warn)
- "Take a time string S and convert it to Remind format.
-KEYWORD is added in front, to make a complete line like DTSTART....
-When INC is non-nil, increase the hour by two (if time string contains
-a time), or the day by one (if it does not contain a time)."
- (let ((t1 (org-parse-time-string s 'nodefault))
- t2 fmt have-time time)
- (if (and (car t1) (nth 1 t1) (nth 2 t1))
- (setq t2 t1 have-time t)
- (setq t2 (org-parse-time-string s)))
- (let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2))
- (d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2)))
- (when inc
- (if have-time
- (if org-agenda-default-appointment-duration
- (setq mi (+ org-agenda-default-appointment-duration mi))
- (setq h (+ 2 h)))
- (setq d (1+ d))))
- (setq time (encode-time s mi h d m y)))
- (setq fmt (concat
- "%d %b %Y"
- (if day-advance-warn (format " ++%d" day-advance-warn))
- (if day-repeat (format " *%d" day-repeat))
- (if have-time " AT %H:%M")))
- (concat keyword (format-time-string fmt time))))
-
-(defun org-rem-time-diff-days (end start)
- (floor (/ (apply '- (mapcar
- (lambda (s)
- (let*
- ((t1 (org-parse-time-string s))
- (s (car t1)) (mi (nth 1 t1))
- (h (nth 2 t1)) (d (nth 3 t1))
- (m (nth 4 t1)) (y (nth 5 t1)))
- (float-time (encode-time s mi h d m y))))
- (list end start))) (* 24 60 60))))
-
-(provide 'org2rem)
-
-;; arch-tag: 65985fe9-095c-49c7-a7b6-cb4ee15c0a95
-
-;;; org-exp.el ends here
diff --git a/.emacs.d/org-7.4/contrib/lisp/orgtbl-sqlinsert.el b/.emacs.d/org-7.4/contrib/lisp/orgtbl-sqlinsert.el
deleted file mode 100644
index 648e44c..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/orgtbl-sqlinsert.el
+++ /dev/null
@@ -1,115 +0,0 @@
-;;; orgtbl-sqlinsert.el --- orgtbl to SQL insert statements.
-
-;; Copyright (C) 2008 Free Software Foundation
-
-;; Author: Jason Riedy <jason@acm.org>
-;; Keywords: org, tables, sql
-
-;; 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 3 of the License, 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, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Converts an orgtbl to a sequence of SQL insertion commands.
-;; Table cells are quoted and escaped very conservatively.
-
-;;; Code:
-
-(defun orgtbl-to-sqlinsert (table params)
- "Convert the orgtbl-mode TABLE to SQL insert statements.
-TABLE is a list, each entry either the symbol `hline' for a horizontal
-separator line, or a list of fields for that line.
-PARAMS is a property list of parameters that can influence the conversion.
-
-Names and strings are modified slightly by default. Single-ticks
-are doubled as per SQL's standard mechanism. Backslashes and
-dollar signs are deleted. And tildes are changed to spaces.
-These modifications were chosed for use with TeX. See
-ORGTBL-SQL-STRIP-AND-QUOTE.
-
-Supports all parameters from ORGTBL-TO-GENERIC. New to this function
-are:
-
-:sqlname The name of the database table; defaults to the name of the
- target region.
-
-:nowebname If not nil, used as a wrapping noweb fragment name.
-
-The most important parameters of ORGTBL-TO-GENERIC for SQL are:
-
-:splice When set to t, return only insert statements, don't wrap
- them in a transaction. Default is nil.
-
-:tstart, :tend
- The strings used to begin and commit the transaction.
-
-:hfmt A function that gathers the quoted header names into a
- dynamically scoped variable HDRLIST. Probably should
- not be changed by the user.
-
-The general parameters :skip and :skipcols have already been applied when
-this function is called."
- (let* (hdrlist
- (alignment (mapconcat (lambda (x) (if x "r" "l"))
- org-table-last-alignment ""))
- (nowebname (plist-get params :nowebname))
- (breakvals (plist-get params :breakvals))
- (firstheader t)
- (*orgtbl-default-fmt* 'orgtbl-sql-strip-and-quote)
- (params2
- (list
- :sqlname name
- :tstart (lambda () (concat (if nowebname
- (format "<<%s>>= \n" nowebname)
- "")
- "BEGIN TRANSACTION;"))
- :tend (lambda () (concat "COMMIT;" (if nowebname "\n@ " "")))
- :hfmt (lambda (f) (progn (if firstheader (push f hdrlist)) ""))
- :hlfmt (lambda (lst) (setq firstheader nil))
- :lstart (lambda () (concat "INSERT INTO "
- sqlname "( "
- (mapconcat 'identity (reverse hdrlist)
- ", ")
- " )" (if breakvals "\n" " ")
- "VALUES ( "))
- :lend " );"
- :sep " , "
- :hline nil
- :remove-nil-lines t))
- (params (org-combine-plists params2 params))
- (sqlname (plist-get params :sqlname)))
- (orgtbl-to-generic table params)))
-
-(defun orgtbl-sql-quote (str)
- "Convert single ticks to doubled single ticks and wrap in single ticks."
- (concat "'" (mapconcat 'identity (split-string str "'") "''") "'"))
-
-(defun orgtbl-sql-strip-dollars-escapes-tildes (str)
- "Strip dollarsigns and backslash escapes, replace tildes with spaces."
- (mapconcat 'identity
- (split-string (mapconcat 'identity
- (split-string str "\\$\\|\\\\")
- "")
- "~")
- " "))
-
-(defun orgtbl-sql-strip-and-quote (str)
- "Apply ORGBTL-SQL-QUOTE and ORGTBL-SQL-STRIP-DOLLARS-ESCAPES-TILDES
-to sanitize STR for use in SQL statements."
- (cond ((stringp str)
- (orgtbl-sql-quote (orgtbl-sql-strip-dollars-escapes-tildes str)))
- ((sequencep str) (mapcar 'orgtbl-sql-strip-and-quote str))
- (t nil)))
-
-(provide 'orgtbl-sqlinsert)
-;;; orgtbl-sqlinsert.el ends here
diff --git a/.emacs.d/org-7.4/contrib/lisp/test-org-export-preproc.el b/.emacs.d/org-7.4/contrib/lisp/test-org-export-preproc.el
deleted file mode 100644
index 3af8461..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/test-org-export-preproc.el
+++ /dev/null
@@ -1,39 +0,0 @@
-(require 'org-export-generic)
-
-(defun test-preproc ()
- (interactive)
- (let ((string
- (let ((region
- (buffer-substring
- (if (org-region-active-p) (region-beginning) (point-min))
- (if (org-region-active-p) (region-end) (point-max))))
- (opt-plist (org-combine-plists (org-default-export-plist)
- (org-infile-export-plist)))
- (export-plist '("tikiwiki" :file-suffix ".txt" :key-binding 85 :header-prefix "" :header-suffix "" :title-format "-= %s =-\n" :date-export nil :toc-export nil :body-header-section-numbers nil :body-section-prefix "\n" :body-section-header-prefix
- ("! " "!! " "!!! " "!!!! " "!!!!! " "!!!!!! " "!!!!!!! ")
- :body-section-header-suffix
- (" \n" " \n" " \n" " \n" " \n" " \n")
- :body-line-export-preformated t :body-line-format "%s " :body-line-wrap nil :body-line-fixed-format " %s\n" :body-list-format "* %s\n" :body-number-list-format "# %s\n" :blockquote-start "\n^\n" :blockquote-end "^\n\n" :body-newline-paragraph "\n" :bold-format "__%s__" :italic-format "''%s''" :underline-format "===%s===" :strikethrough-format "--%s--" :code-format "-+%s+-" :verbatim-format "~pp~%s~/pp~")))
- (org-export-preprocess-string
- region
- :for-ascii t
- :skip-before-1st-heading
- (plist-get opt-plist :skip-before-1st-heading)
- :drawers (plist-get export-plist :drawers-export)
- :tags (plist-get export-plist :tags-export)
- :priority (plist-get export-plist :priority-export)
- :footnotes (plist-get export-plist :footnotes-export)
- :timestamps (plist-get export-plist :timestamps-export)
- :todo-keywords (plist-get export-plist :todo-keywords-export)
- :verbatim-multiline t
- :select-tags (plist-get export-plist :select-tags-export)
- :exclude-tags (plist-get export-plist :exclude-tags-export)
- :emph-multiline t
- :archived-trees
- (plist-get export-plist :archived-trees-export)
- :add-text (plist-get opt-plist :text)))))
- (save-excursion
- (switch-to-buffer "*preproc-temp*")
- (point-max)
- (insert string))))
-