diff options
| author | Luke Shumaker <LukeShu@sbcglobal.net> | 2011-05-17 16:27:50 -0400 |
|---|---|---|
| committer | Luke Shumaker <LukeShu@sbcglobal.net> | 2011-05-17 16:27:50 -0400 |
| commit | b81536ad49001abf292bd31a0dcbf57e387387b1 (patch) | |
| tree | 722cac2e9eab46a3b18d930dcd37703df48ebeba /.emacs.d/org-7.4/contrib/lisp | |
| parent | 5b8794f1f5e82c1a220f36a724e5c8ce3335c462 (diff) | |
Fiddle with emacs config (when to use -n, -c), get emacs using el-get.
Diffstat (limited to '.emacs.d/org-7.4/contrib/lisp')
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 Binary files differdeleted file mode 100644 index 5008ddf..0000000 --- a/.emacs.d/org-7.4/contrib/lisp/.DS_Store +++ /dev/null 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, -\"©\" *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, \"©\" is exactly equivalent to \"©\". - -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 ?&) "&" - (aref table ?<) "<" - (aref table ?>) ">" - ;; 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 ?\") """ - ) - 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 @. -`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 "@" 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 - "<\\(\\(mailto:\\)?\\([-=+_.a-zA-Z0-9]+@[-_.a-zA-Z0-9]+\\)\\)>" - nil t) - (let ((address (match-string 3)) - (link-text (match-string 1))) - (delete-region (match-beginning 0) (match-end 0)) - (insert "<<a href=\"mailto:" - (htmlize-despam-address address) - "\">" - (htmlize-despam-address link-text) - "</a>>"))) - (goto-char (point-min)) - (while (re-search-forward "<\\(\\(URL:\\)?\\([a-zA-Z]+://[^;]+\\)\\)>" - nil t) - (let ((url (match-string 3)) - (link-text (match-string 1))) - (delete-region (match-beginning 0) (match-end 0)) - (insert "<<a href=\"" url "\">" link-text "</a>>")))) - -;; 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:" 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)))) - |